Array code not written correctly

[panyagak]

kindly refer to this link from which this Array code was "improved upon", but which cant work due to "object code error". The array code was untested by the coder.

PICK OUT/EXTRACT column header "COMMON" IN ALL 5 SHEETS

Sub FindAll2()
    Dim lr As Long 'Last row in Wk1
    Dim nr As Long ' next available row in New All
    Dim i As Integer 'counter for worksheets
    Dim outarr As Variant
    On Error GoTo errHandle
    Application.EnableEvents = False
    Application.ScreenUpdating = False
   ' load all 5 sheets into varaint arrays
    lr1 = Worksheets("Wk1").Range("A" & Rows.Count).End(xlUp).Row
    w1arr = Worksheets("Wk1").Range(Cells(1, 1), Cells(lr1, 26))  ' I put 26 columns in because you wanted to check columnn z
    lr2 = Worksheets("Wk2").Range("A" & Rows.Count).End(xlUp).Row
    w2arr = Worksheets("Wk2").Range(Cells(1, 1), Cells(lr2, 26))  ' I put 26 columns in because you wanted to check columnn z
    lr3 = Worksheets("Wk3").Range("A" & Rows.Count).End(xlUp).Row
    w3arr = Worksheets("Wk3").Range(Cells(1, 1), Cells(lr3, 26))  ' I put 26 columns in because you wanted to check columnn z
    lr4 = Worksheets("Wk4").Range("A" & Rows.Count).End(xlUp).Row
    w4arr = Worksheets("Wk4").Range(Cells(1, 1), Cells(lr4, 26))  ' I put 26 columns in because you wanted to check columnn z
    lr5 = Worksheets("Wk5").Range("A" & Rows.Count).End(xlUp).Row
    w5arr = Worksheets("Wk5").Range(Cells(1, 1), Cells(lr5, 26))  ' I put 26 columns in because you wanted to check columnn z
    nr = Worksheets("New All").Range("A" & Rows.Count).End(xlUp).Row + 1
    ReDim outarr(1 To lr1, 1 To 26)
    'Get Names range
   ' Set rNames = Worksheets("Wk1").Range("B2:B" & lr)
    indi = 1
    For i = 1 To lr1
        wkcnt = 0
        thisname = w1arr(i, 2) ' column b of first worksheet
        For j = 1 To lr2
         If thisname = w2arr(j, 2) Then
          wkcnt = wkcnt + 1
          Exit For
         End If
        Next j
        For j = 1 To lr3
         If thisname = w3arr(j, 2) Then
          wkcnt = wkcnt + 1
          Exit For
         End If
        Next j
        For j = 1 To lr4
         If thisname = w4arr(j, 2) Then
          wkcnt = wkcnt + 1
          Exit For
         End If
        Next j
        For j = 1 To lr5
         If thisname = w5arr(j, 2) Then
          wkcnt = wkcnt + 1
          Exit For
         End If
        Next j
        If wkcnt = 4 Then
        'only get here if name is found in each sheet
        ' copy input row to output array
        For kk = 1 To 26
         outarr(indi, kk) = w1arr(i, kk)
        Next kk
        indi = indi + 1
        End If
    Next i
    ' write output array to workhseet
   Worksheets("New All").Range(Cells(nr, 1), Cells(nr + indi, 26)) = outarr
    Application.EnableEvents = True
    Application.ScreenUpdating = True
Exit Sub
errHandle:
    MsgBox Err.Description, vbCritical, Err.Number
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Kindly help out.

 

[mart37]

Dim w1arr As Variant
w1arr = Worksheets("Wk1").Range(Worksheets("Wk1").Cells(1, 1), Worksheets("Wk1").Cells(lr1, 26)) ' I put 26 columns in because you wanted to check columnn z

 

[panyagak]

mart37

"Dim w1arr As Variant" wil cater for the rest w2arr w3arr, w4arr, w5arr?

Regards

 

[mart37]

You have to repeat that for all array's.
But the problem was:
w1arr = Worksheets("Wk1").Range(Worksheets("Wk1").Cells(1, 1), Worksheets("Wk1").Cells(lr1, 26))

 

[panyagak]

mart37

As in

Dim w1arr As Variant
Dim w2arr As Variant
Dim w3arr As Variant
Dim w4arr As Variant
Dim w5arr As Variant

 

[mohadin]

So why not use

 w1arr = Worksheets("Wk1").Cells(1, 1).Resize(lr1, 26)

 w1arr = Worksheets("Wk1").Range(Worksheets("Wk1").Cells(1, 1), Worksheets("Wk1").Cells(lr1, 26))

 With Worksheets("Wk1")
        w1arr = .Range(.Cells(1, 1), .Cells(lr1, 26))
    End With

 

[panyagak]

mohadin & mart37

i dont mind, if your different approaches can make the code run!!

Also in the code, is this bit right?

  ' write output array to workhseet
   Worksheets("New All").Range(Cells(nr, 1), Cells(nr + indi, 26)) = outarr

 

[mohadin]

For

 Worksheets("New All").Range(Cells(nr, 1), Cells(nr + indi, 26)) = outarr

Try

 Worksheets("New All").Cells(nr, 1).Resize(UBound(outarr), UBound(outarr, 2)) = outarr

 

[panyagak]

mohadin & mart37

am using a smartphone to interact. (will test much later)

With the small proposed changes, could you assure the entire code can run on your self-created sample sheets: Wk1 Wk2 Wk3 Wk4 Wk5 New ALL?

Regards.

 

[panyagak]

So why not use

 w1arr = Worksheets("Wk1").Cells(1, 1).Resize(lr1, 26)

 w1arr = Worksheets("Wk1").Range(Worksheets("Wk1").Cells(1, 1), Worksheets("Wk1").Cells(lr1, 26))

 With Worksheets("Wk1")
        w1arr = .Range(.Cells(1, 1), .Cells(lr1, 26))
    End With

mohadin

you would rather incorporate your changes to the entire code + add comments & post as entire code; it almost starts to confuse where to place your code changes.

mart37 is watching....

regards