Using an array? - to FIND any value on multiple sheets automatically - or any other simple way

[chazrab]

Title explains most. Code below works well as a traditional FIND method, but I can only get it to run for one sheet. How would you do this for any number
of specified sheets? My workbook has about 100 sheets. I don't want the code to go through every sheet - only ones I specify for different search values for different
sheets.

Private Sub cmdGOFIND_Click()
 Application.EnableEvents = False
 Application.ScreenUpdating = False
Sheets("REPORT").UsedRange.ClearContents
Dim lastrow As Integer
Dim X As String
Dim c As Range
Dim rw As Long
Dim firstAddress As Variant
Dim Rowno As Variant
X = Me.TextBox1.value
With Worksheets("CARDS").Range("A1:G1000")
    Set c = .FIND(X, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
rw = 1
firstAddress = c.Address
Do
Worksheets("CARDS").Select
c.Select
Range(Cells(c.Row, 1), Cells(c.Row, 7)).copy Destination:=Sheets("REPORT").Range("A" & rw)
                rw = rw + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
Else
MsgBox "No value found"
End If
End With
Rowno = Sheets("RESULT").Range("B2").End(xlDown).Row
CARDRESULTS.Show
Sheets("BUDGET").Select
Unload Me
 Application.EnableEvents = True
 Application.ScreenUpdating = True
End Sub

The question is, how would do this for multiple sheets automatically going from one sheet to the next
with sheet names specified in an array or any other way in the VB code ?.
(Sheet names are renamed CARDS2015, CARDS2016, CARDS2017, CARDS2018, CARDS2019, CARDS2020, CARDS2021, CARDS2022).
I just put the renamed sheets in to let you know that I've renamed the sheets - not the ones assigned by Excel for new sheet name designations.

Thanks for anyone's help. Seems simple enough. Just can't get the code to continue performing FIND going from sheet to sheet automatically and copying
results to a new sheet(REPORT)

cr

 

[CSmith]

Here is working code:

Private Sub cmdGOFIND_Click()
    Dim lr              As Long
    Dim wsArr           As Variant
    Dim Found           As Boolean
    Dim x               As String, firstAddress As String
    Dim rngSearch       As Range, c As Range, rng As Range
    Dim wsReport        As Worksheet, ws As Worksheet
 
    x = Me.TextBox1.Value
    If Len(x) = 0 Then Exit Sub
 
    On Error GoTo myerror
    Set wsReport = ThisWorkbook.Worksheets("REPORT")
 
    wsArr = Array("CARDS2015", "CARDS2016", "CARDS2017", "CARDS2018", "CARDS2019", "CARDS2020", "CARDS2021", "CARDS2022")
 
    wsReport.UsedRange.ClearContents
 
    For Each ws In ThisWorkbook.Worksheets(wsArr)
   
        Set rngSearch = ws.Columns(4)
   
        Set c = rngSearch.Find(x, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
        If Not c Is Nothing Then
       
            firstAddress = c.Address
            Found = True
            Do
           
                If Not c Is Nothing Then
                    Set rng = ws.Cells(c.Row, c.Column).Resize(, 7)
                    lr = wsReport.Cells(wsReport.Rows.Count, "A").End(xlUp).Row + 1
                    rng.Copy wsReport.Cells(lr, 1)
                End If
           
                Set c = rngSearch.FindNext(c)
                If c Is Nothing Then Exit Do
       
            Loop While c.Address <> firstAddress
       
        End If
        'release object variables
        Set rngSearch = Nothing
        Set rng = Nothing
        Set c = Nothing
    Next ws
 
    If Not Found Then Err.Raise 53, , "Search Value Not Found"
 
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
Me.Hide
End Sub

Error was from trying to resize non-contiguous ranges . . .
Also, even changing to resize before it would not like copying non-contiguous ranges either . . .

 

[chazrab]

Reply back re error generated code. Images below explain where problems occur and prevent running perfectly.
Not to be redundant, but what this code should do if it works correctly is just to go from every sheet name in the array
from CARDS2015 to CARDS2022 and search for a particular value entered into Textbox1 on a userform named FINDCARDVAL.
When and if a value is found, ir will display the results of the entire row from A:G in a listbox on the userform.
Thanks again for all your help.
cr

 

[dmt32]

Reply back re error generated code. Images below explain where problems occur and prevent running perfectly.

Hi,
as pointed out by @CSmith looks like I was having another senior moment when resizing the range

See if this update resolves the issue

Private Sub cmdFINDCARDVAL2_Click()
    Dim lr               As Long
    Dim wsArr            As Variant
    Dim Found           As Boolean
    Dim x               As String, firstAddress As String
    Dim rngSearch       As Range, c As Range, rng As Range
    Dim wsReport        As Worksheet, ws As Worksheet
     x = Me.TextBox1.Value
    If Len(x) = 0 Then Exit Sub
 
   On Error GoTo myerror
    Set wsReport = ThisWorkbook.Worksheets("REPORT")
 
    wsArr = Array("CARDS2015", "CARDS2016", "CARDS2017", "CARDS2018", "CARDS2019", "CARDS2020", "CARDS2021", "CARDS2022")
 
    wsReport.UsedRange.ClearContents
 
     For Each ws In ThisWorkbook.Worksheets(wsArr)
           Set rngSearch = ws.Columns(4)
             Set c = rngSearch.Find(x, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
                If Not c Is Nothing Then
                     firstAddress = c.Address
                            Found = True
                               Do
                                  If rng Is Nothing Then
                                     Set rng = ws.Cells(c.Row, 1).Resize(1, 7)
                                  Else
                                    Set rng = Union(ws.Cells(c.Row, 1).Resize(1, 7), rng)
                                  End If
                                    Set c = rngSearch.FindNext(c)
                                 If c Is Nothing Then Exit Do
                            Loop While c.Address <> firstAddress
                  lr = wsReport.Cells(wsReport.Rows.Count, "A").End(xlUp).Row + 1
                  If Not rng Is Nothing Then rng.Copy wsReport.Cells(lr, 1)
          End If
        'release object variables
        Set rngSearch = Nothing
        Set rng = Nothing
        Set c = Nothing
    Next ws
 
    If Not Found Then Err.Raise 53, , "Search Value Not Found"
 
'commented out but  need to add this code to display results in userform  5/3/23*******************************
'CARDRESULTS.Show
'Sheets("BUDGET").Select

'mycode 5/3/23*************************************


myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Solution attempts to only resolve the issue of copying data to Report sheet - you will need to add additional code where shown to populate your userform listbox

Dave

 

[CSmith]

Reply back re error generated code. Images below explain where problems occur and prevent running perfectly.
Not to be redundant, but what this code should do if it works correctly is just to go from every sheet name in the array
from CARDS2015 to CARDS2022 and search for a particular value entered into Textbox1 on a userform named FINDCARDVAL.
When and if a value is found, ir will display the results of the entire row from A:G in a listbox on the userform.
Thanks again for all your help.
cr

I gave you updated code that works for the userform find.

Dave:

Hi,
as pointed out by @CSmith looks like I was having another senior moment when resizing the range

See if this update resolves the issue

. . .
                  lr = wsReport.Cells(wsReport.Rows.Count, "A").End(xlUp).Row + 1
                  If Not rng Is Nothing Then rng.Copy wsReport.Cells(lr, 1)
. . .

Solution attempts to only resolve the issue of copying data to Report sheet - you will need to add additional code where shown to populate your userform listbox

Dave

You code above will still error as it does not like to copy/paste non-contiguous ranges.

 

[chazrab]

Hi Dave and CSMith
updated code words great. Added my code to display results in a userform
+ the following:

at beginning:
  Dim wsReport        As Worksheet, ws As Worksheet
 'added 5/4/23 ***************************************
 Application.EnableEvents = False
 Application.ScreenUpdating = False
 'added 5/4/23 **************************************

' added this code to display results in userform  5/4/23*******************************
CARDRESULTS.Show
Sheets("BUDGET").Select
Unload Me
 Application.EnableEvents = True
 Application.ScreenUpdating = True
'mycode 5/4/23*************************************
End Sub

Displays all search results in Userform listbox1 for any value I assign to Textbox1 on the userform
As a further comment, I should be able to use this exact same code for any set of sheets I insert into the array code line.

dmt32, CSmith, thanks to both for all your help. Been wanting to develop this for years for tracking past historical transactions
for any given array of sheets.

cr
Kingwood, Tx

 

[CSmith]

Hi Dave and CSMith
updated code words great. Added my code to display results in a userform

. . .

dmt32, CSmith, thanks to both for all your help. Been wanting to develop this for years for tracking past historical transactions
for any given array of sheets.

cr
Kingwood, Tx

Welcome! Thanks for the update and feedback.

 

[dmt32]

I gave you updated code that works for the userform find.

Dave:


You code above will still error as it does not like to copy/paste non-contiguous ranges.

Using Union should work perfectly ok & negates need to copy each line individually which on large data set may prove quite slow.

Dave

 

[dmt32]

thanks to both for all your help. Been wanting to develop this for years for tracking past historical transactions
for any given array of sheets.

most welcome glad we were able to help resolve

Dave

 

[chazrab]

Hi Dave - I created a new button on the userform, used your code with the Union statement, and it works great.

Thanks again to both for all your help.
cr

 

[dmt32]

Hi Dave - I created a new button on the userform, used your code with the Union statement, and it works great.

Apart from using autofilter, it is a faster way of copying (or deleting) multiple ranges as you perform the operation just once - I just had one of my senior moments when first posted with the resizing of the range but glad now resolved

Appreciate additional feedback but please also mark solution used as solution as this helps others searching.

Dave