Hi Experts,
Code: Select all
Sub STEP11()
Dim Wb2 As Workbook
Set Wb2 = Workbooks.Open("C:\Users\**I've been banned**\Desktop\**I've been banned**\9.15\Files\QuantitY.xlsx")
Dim Ws1 As Worksheet: Set Ws1 = Wb2.Worksheets.Item(1)
Dim Lr1 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
Dim arrA() As Variant: Let arrA() = Ws1.Range("A1:A" & Lr1 & "").Value2
Dim Wb As Workbook, Ws As Worksheet
Set Wb = Workbooks.Open("C:\Users\**I've been banned**\Desktop\**I've been banned**\9.15\Files\FundsCheck.xlsb")
Set Ws = Wb.Worksheets.Item(1)
Dim Lr As Long: Let Lr = Ws.Range("A" & Ws.Rows.Count & "").End(xlUp).Row
Dim rngIn As Range: Set rngIn = Ws.Range("A1:S" & Lr & "")
Dim arrIn() As Variant, arrOut() As Variant: Let arrIn() = rngIn.Value2
Dim arrB() As Variant: Let arrB() = Ws.Range("B1:B" & Lr & "").Value2
Dim SomeQ As Double: Let SomeQ = Ws.Evaluate("=SUM(Q2:Q" & Lr & ")")
Let SomeQ = Application.WorksheetFunction.Round(SomeQ, 2)
Dim S10Val As Double: Let S10Val = arrIn(10, 19)
If SomeQ > S10Val Then
ElseIf SomeQ < S10Val Then
Dim S10dQ As Double: Let S10dQ = S10Val / SomeQ
Let S10dQ = Int(S10dQ)
Dim Cnt '
For Cnt = 2 To Lr1 '
Dim MtchRes As Variant
Let MtchRes = Application.Match(arrA(Cnt, 1), arrB(), 0)
If IsError(MtchRes) Then
Else
Dim Lc1Cnt As Long: Let Lc1Cnt = Ws1.Cells.Item(Cnt, Ws1.Columns.Count).End(xlToLeft).Column
Let Ws1.Range("B" & Cnt & ":" & CL(Lc1Cnt) & Cnt & "").Value = Ws1.Evaluate("=" & S10dQ & "*" & Ws1.Range("B" & Cnt & ":" & CL(Lc1Cnt) & Cnt & "").Address & "")
End If
Next Cnt
Ws.Range("S10").Copy
Ws.Range("S8:S9").PasteSpecial Paste:=xlPasteValues
Else
End If
Wb2.Save
Wb.Save
Wb2.Close
Wb.Close
End Sub
Public Function CL(ByVal lclm As Long) As String
Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function
I am getting Error while runing the macro
Error Details: Run time error 9 subscript out of range
Highlighted line: : Let S10Val = arrIn(10, 19)