Run time Error '9'

[LikeButtah1]

I am getting a run time error '9' subscript out of range (in red) and I'm unsure why since it was working and now not working. I obviously changed something but I'm unsure what I did. Any help with this code would be appreciated. Thanks.

Sub DistributeFromBiWeeklyPayroll()

  Dim R As Long, LastRow As Long, NextRow As Long, ws As Worksheet
  Dim LastNames As Variant, QData As Variant
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  LastNames = Range("B4", Cells(LastRow, "B"))
  QData = Range("F4", Cells(LastRow, "F"))
  For R = 1 To UBound(LastNames)
    Set ws = Sheets(LastNames(R, 1))
    NextRow = Application.Max(5, ws.Cells(ws.Rows.Count, "C").End(xlUp).Row) + 1
    ws.Cells(NextRow, "C") = QData(R, 1)
  Next
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  LastNames = Range("B4", Cells(LastRow, "B"))
  QData = Range("N4", Cells(LastRow, "N"))
  For R = 1 To UBound(LastNames)
    Set ws = Sheets(LastNames(R, 1))
    NextRow = Application.Max(5, ws.Cells(ws.Rows.Count, "E").End(xlUp).Row) + 1
    ws.Cells(NextRow, "E") = QData(R, 1)
  Next
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  LastNames = Range("B4", Cells(LastRow, "B"))
  QData = Range("O4", Cells(LastRow, "O"))
  For R = 1 To UBound(LastNames)
    Set ws = Sheets(LastNames(R, 1))
    NextRow = Application.Max(5, ws.Cells(ws.Rows.Count, "J").End(xlUp).Row) + 1
    ws.Cells(NextRow, "J") = QData(R, 1)
  Next
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  LastNames = Range("B4", Cells(LastRow, "B"))
  QData = Range("J4", Cells(LastRow, "J"))
  For R = 1 To UBound(LastNames)
    Set ws = Sheets(LastNames(R, 1))
    NextRow = Application.Max(5, ws.Cells(ws.Rows.Count, "F").End(xlUp).Row) + 1
    ws.Cells(NextRow, "F") = QData(R, 1)
  Next
   LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  LastNames = Range("B4", Cells(LastRow, "B"))
  QData = Range("K4", Cells(LastRow, "K"))
  For R = 1 To UBound(LastNames)
    Set ws = Sheets(LastNames(R, 1))
    NextRow = Application.Max(5, ws.Cells(ws.Rows.Count, "G").End(xlUp).Row) + 1
    ws.Cells(NextRow, "G") = QData(R, 1)
  Next
    LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  LastNames = Range("B4", Cells(LastRow, "B"))
  QData = Range("L4", Cells(LastRow, "L"))
  For R = 1 To UBound(LastNames)
    Set ws = Sheets(LastNames(R, 1))
    NextRow = Application.Max(5, ws.Cells(ws.Rows.Count, "H").End(xlUp).Row) + 1
    ws.Cells(NextRow, "H") = QData(R, 1)
  Next
      LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  LastNames = Range("B4", Cells(LastRow, "B"))
  QData = Range("M4", Cells(LastRow, "M"))
  For R = 1 To UBound(LastNames)
    Set ws = Sheets(LastNames(R, 1))
    NextRow = Application.Max(5, ws.Cells(ws.Rows.Count, "I").End(xlUp).Row) + 1
    ws.Cells(NextRow, "I") = QData(R, 1)
  Next
  Range("A1").Select
End Sub

 

[JackDanIce]

You have that error because array LastNames has 2 dimensions and your loop is starting with 1 rather than Lbound(LastNames)

Not tested, but this may be able to replace all of your code:

Sub M1()

    Dim x       As Long
    Dim i       As Long
    Dim arr()   As Variant
    Dim arr1()  As Variant
    Dim arr2()  As Variant
    
    arr = Split("F|C,N|E,O|J,J|F,K|G,L|H,M|I", ",")
    
    For i = LBound(arr, 1) To UBound(arr, 1)
        x = Cells(Rows.Count, 2).End(xlUp).Row
        arr1 = Cells(4, 2).Resize(x - 3).Value
        arr2 = Range(Split(arr(i))(0) & 4).Resize(x - 3).Value
        For x = LBound(arr, 1) To UBound(arr, 1)            NextRow CStr(arr1(x, 1)), Split(arr(i), "|")(1), arr2(x, 1)
        Next x
        Erase arr1: Erase arr2
    Next i
    
    Erase arr
    
End Sub

Private Sub NextRow(ByRef str1 As String, ByRef colLetter As String, ByRef var As Variant)
        
    Dim str As String: str = "isref(@Name!A1)"
            
    If Not Evaluate(Replace(str, "@Name", str1)) Then
        With Sheets(str1)
            .Range(colLetter & Application.Max(5, .Cells(.Rows.Count, 3).End(xlUp).Row) + 1).Value = var
        End With
    End If
    
End Sub

If it doesn't work, note line in blue and adjust your line in red to mimic as I recreated your error when using For x = 1 to Ubound(LastNames)

 

[LikeButtah1]

JackDanIce,
Getting a compile error ByRef arugument type mismatch by here (in Red):

Sub M1()

    Dim x       As Long
    Dim i       As Long
    Dim arr()   As Variant
    Dim arr1()  As Variant
    Dim arr2()  As Variant
    
    arr = Split("F|C,N|E,O|J,J|F,K|G,L|H,M|I", ",")
    
    For i = LBound(arr, 1) To UBound(arr, 1)
        x = Cells(Rows.Count, 2).End(xlUp).Row
        arr1 = Cells(4, 2).Resize(x - 3).Value
        arr2 = Range(Split(arr(i))(0) & 4).Resize(x - 3).Value
        For x = LBound(arr, 1) To UBound(arr, 1)
        NextRow CStr(arr1(x, 1)), Split(arr(i), "|")(1), arr2(x, 1)
        Next x
        Erase arr1: Erase arr2
    Next i
    
    Erase arr
    
End Sub

 

[JackDanIce]

Try:

Sub M1()

    Dim x       As Long
    Dim i       As Long
    Dim arr     As Variant
    Dim arr1()  As Variant
    Dim arr2()  As Variant
    
    arr = Split("F|C,N|E,O|J,J|F,K|G,L|H,M|I", ",")
    
    For i = LBound(arr, 1) To UBound(arr, 1)
        x = Cells(Rows.Count, 2).End(xlUp).Row
        x = 5
        arr1 = Cells(4, 2).Resize(x - 3).Value
        arr2 = Range(CStr(Split(arr(i), "|")(0)) & "4").Resize(x - 3).Value
        For x = LBound(arr1, 1) To UBound(arr1, 1)
            If Len(CStr(arr1(x, 1))) Then NextRow CStr(arr1(x, 1)), CStr(Split(arr(i), "|")(1)), CStr(arr2(x, 1))
        Next x
        Erase arr1: Erase arr2
    Next i
    
    Erase arr
    
End Sub

Private Sub NextRow(ByRef str1 As String, ByRef colLetter As String, ByRef str2 As String)
        
    Dim str As String: str = "isref(@Name!A1)"
            
    If Evaluate(Replace(str, "@Name", str1)) Then
        With sheets(str1)
            .Range(colLetter & Application.Max(5, .Cells(.Rows.Count, 3).End(xlUp).Row) + 1).Value = str2
        End With
    End If
    
End Sub

 

[JackDanIce]

Remove line x = 5 (was testing and forgot to delete before posting)

 

[LikeButtah1]

Nothing is being distributed from the payroll sheet to the individual employee sheets using your current code.

The original code did work but now is giving an error at Set ws = Sheets(LastNames(R, 1))

 

[JackDanIce]

#2

you have that error because array lastnames has 2 dimensions and your loop is starting with 1 rather than lbound(lastnames)

 

[LikeButtah1]

got a run time error'-2147352565(8002000b)' The item with the specified name wasn't found here (in red)

Private Sub NextRow(ByRef str1 As String, ByRef colLetter As String, ByRef var As Variant)        
    Dim str As String: str = "isref(@Name!A1)"
            
    If Not Evaluate(Replace(str, "@Name", str1)) Then
        With Sheets(str1)
            .Range(colLetter & Application.Max(5, .Cells(.Rows.Count, 3).End(xlUp).Row) + 1).Value = var
        End With
    End If
    
End Sub

 

[JackDanIce]

Remove Not and try

 

[LikeButtah1]

So when I use:
For R = LBound(LastNames) To UBound(LastNames)
it is still giving me the error '9' subscript out of range in the next line:
Set ws = Sheets(LastNames(R, 1))