Array code not written correctly

panyagak

Active Member
Joined
Feb 24, 2017
Messages
271
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


Code:
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.
 

panyagak

Active Member
Joined
Feb 24, 2017
Messages
271
So you are quite happy for members to potentially waste their time are you? IMO THAT is not fair!!
and as for
Rory was helping you 2 days ago & you only came back to him about 25mins before starting this thread, so give me that rubbish.
In future please obey the rules & do not shout.

seems further help to my thread has come
to an end.....Just like that
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,535
Office Version
  1. 365
Platform
  1. Windows
Give people a chance, has it occurred to you that members have a life outside the board & are scattered around the world, so in different time zones.
 

panyagak

Active Member
Joined
Feb 24, 2017
Messages
271
Give people a chance, has it occurred to you that members have a life outside the board & are scattered around the world, so in different time zones.


Sorry for private message, Lord have Mercy!!!

i didnt meant to hurt, on an easy Sunday morning like today
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,696
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
seems further help to my thread has come
to an end.....Just like that
Perhaps consider if your attitude might be the cause?
 

panyagak

Active Member
Joined
Feb 24, 2017
Messages
271

ADVERTISEMENT

Perhaps consider if your attitude might be the cause?

RoryA

i wish you knew how innocent and shocked i am......cant believe what happened today

life has to move on.....keep quiet

no attitude issues.
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,091
Office Version
  1. 2013
Platform
  1. Windows
What was happening here!!!!!!
As Mr. Fluff In #22
+ So many troubles I have
+ Broken laptop at home, I cannot afford the repair
No body should to bother about it
Replace
VBA Code:
 Worksheets("New All").Range(Cells(nr, 1), Cells(nr + indi, 26)) = outarr
with
VBA Code:
 With Worksheets("New All")
        .Cells(nr, 1).Resize(nr + indi, 26) = aoutarr
    End With
Hope this will help
 

panyagak

Active Member
Joined
Feb 24, 2017
Messages
271

ADVERTISEMENT

What was happening here!!!!!!
As Mr. Fluff In #22
+ So many troubles I have
+ Broken laptop at home, I cannot afford the repair
No body should to bother about it
Replace
VBA Code:
 Worksheets("New All").Range(Cells(nr, 1), Cells(nr + indi, 26)) = outarr
with
VBA Code:
 With Worksheets("New All")
        .Cells(nr, 1).Resize(nr + indi, 26) = aoutarr
    End With
Hope this will help

mohadin

if i had not sent Fluff a private message, he would not have seen my thread:

i could feel his fury in my next room, never mind am on antidepressants!!!

Fluff sorry, Fluff i invite you to Kenya, there are so many UK citizens& soldiers alike: A British Army Base @Nanyuki & major tourist attractions here: you will handle Mrexcel right here in Kenya.

no hard feelings at all for Fluff, could be Covid19-after shocks

thanks mohadin, will implement
 

panyagak

Active Member
Joined
Feb 24, 2017
Messages
271
mohadin

if i had not sent Fluff a private message, he would not have seen my thread:

i could feel his fury in my next room, never mind am on antidepressants!!!

Fluff sorry, Fluff i invite you to Kenya, there are so many UK citizens& soldiers alike: A British Army Base @Nanyuki & major tourist attractions here: you will handle Mrexcel right here in Kenya.

no hard feelings at all for Fluff, could be Covid19-after shocks

thanks mohadin, will implement

Thanks mohadin.

I tried out the code and various suggestions though in Wk1 & Wk2 only: only the header row outputted in New ALL.

I SUSPECT THIS: My Column B consists of Text (String) and Numbers (Values) all CONCATENATED TOGETHER hence its not A HOMOGENOUS Coln.

Just did did lots of reading on Arrays

regards
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,129,499
Messages
5,636,682
Members
416,935
Latest member
Atulcp

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top