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

C

chazrab

Well-known Member
Joined
Oct 21, 2006
Messages
884
Office Version
  1. 365
Platform
  1. Windows
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.
Code: 
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
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
try this (untested) but it does show you how to loop through a list of worksheets. If you have a lot of worksheets and want all of them except a few, It could be easier to list the ones you don't wanat and check for those
VBA Code: 
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
rw = 1  ' move this out side the loop
shtnamnes = Array(CARDS2015, CARDS2016, CARDS2017, CARDS2018, CARDS2019, CARDS2020, CARDS2021, CARDS2022)
X = Me.TextBox1.Value
For i = 0 To UBound(shtnames)
With Worksheets(shtnames(i)).Range("A1:G1000")
    Set c = .Find(X, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
firstAddress = c.Address
Do
'Worksheets("CARDS").Select
'c.Select
' change references to the "with" workhseet by adding dots
.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
Next i
Rowno = Sheets("RESULT").Range("B2").End(xlDown).Row
CARDRESULTS.Show
Sheets("BUDGET").Select
Unload Me
 Application.EnableEvents = True
 Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi,
untested but see if this update to your code does what you want

VBA 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.Range("A:G")
       
        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)
                Else
                    Set rng = Union(ws.Cells(c.Row, 1), 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.Resize(, rngSearch.Columns.Count).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"
   
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
   
End Sub



Dave
 
Upvote 0
Hi Dave - sorry I'm late getting back to you. I copied your code, ran it, and it generated run time errors. I tried several
times to change a few things but the code still does not go from one sheet to another looking for a FIND value of x = anything.
BTW, if this helps at all, the FIND code will only search one column on every selected sheet in an array - column D, but the code
will copy from row A to G and display all results in a userform listbox.

Experimented with Autofilter with an imput variable X to filter on to do this, but still having trouble with code moving automatically through multiple selected sheets. (Autofilter does seem faster, though)

Here's the code I'm using with your changes:
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
    'Dim rw As Long  '( added, then removed)
    x = Me.TextBox1.value
    If Len(x) = 0 Then Exit Sub
'    On Error GoTo myerror  --- error (label not defined ?)
    Set wsReport = ThisWorkbook.Worksheets("REPORT")
    wsArr = Array("CARDS2015", "CARDS2016", "CARDS2017", "CARDS2018", "CARDS2019", "CARDS2020", "CARDS2021", "CARDS2022")
    wsReport.UsedRange.ClearContents
    wsReport.UsedRange.Delete
    For Each ws In ThisWorkbook.Worksheets(wsArr)
     Set rngSearch = ws.Range("D:D") '(only search col D on all sheets in array)
     Set c = rngSearch.FIND(x, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
        If Not c Is Nothing Then
        'rw = 1
           firstAddress = c.Address
           Found = True
              Do
               If rng Is Nothing Then
                   Set rng = ws.Cells(c.Row, 1)
               Else
                  Set rng = Union(ws.Cells(c.Row, 1), 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.Resize(, rngSearch.Columns.count).copy wsReport.Cells(lr, 1) '(Run time error 1004.   Application defined or object defined error)
c.Select '('added this. Didn't seem to work)
c.Range(Cells(c.Row, 1), Cells(c.Row, 7)).copy Destination:=Sheets("REPORT").Range("A" & rw) '(this works on other FIND code I've used )

     c.copy wsReport.Cells(lr, 1)
     End If
         Set rngSearch = Nothing
         Set rng = Nothing
         Set c = Nothing
End If
Next
End Sub

Must be something minor in the code. Still trying to make it work on my end.
Thanks very much for all your help.
cr
 
Upvote 0
chazrab said:
For Each ws In ThisWorkbook.Worksheets(wsArr)
Click to expand...
I think you may need to change this to :
For Each wsName in wsArr

And add
This line:
Set ws = ThisWorkbook.Worksheets(wsName)
chazrab said:
Set rngSearch = ws.Range("D:D") '(only search col D on all sheets in array)
Click to expand...
before the above line.

Have not read through entire code block just the mistake on the element . . .
 
Upvote 0
Dave, it's me again. The following code I wrote works great but only runs on one sheet.
See Userform result image below search for "food" in col D
Code: 
Private Sub cmdGOFIND_Click()
 Application.EnableEvents = False
 Application.ScreenUpdating = False
Sheets("REPORT").UsedRange.ClearContents
Dim lastrow As Integer
Dim X
Dim y As Variant
Dim c As Range
Dim rw As Long
Dim firstAddress As Variant
Dim Rowno As Variant
X = Me.TextBox1.value
y = ComboBox1.value

With Worksheets("CARDS2015").Range("D1:D1000")
    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("CARDS2015").Activate
Sheets("CARDS2015").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("REPORT").Range("B2").End(xlDown).Row
CARDRESULTS.Show
Sheets("BUDGET").Select
Unload Me
 Application.EnableEvents = True
 Application.ScreenUpdating = True
End Sub

Thanks for all your help, once again.
cr
 

Attachments

  • FIND RESULT.png
    FIND RESULT.png
    112.3 KB · Views: 8
Upvote 0
CSmith said:
I think you may need to change this to :
For Each wsName in wsArr

And add
This line:
Set ws = ThisWorkbook.Worksheets(wsName)

before the above line.

Have not read through entire code block just the mistake on the element . . .
Click to expand...
Thanks, CSmith. I'll try this now. This should not be a difficult task to do. BTW: I added another follow up comment aftet
my first reply that you replied to with code that does work and the userform which displays the results.
That code works great, but again, I'm only searching for a value on one sheet data that was generated in 2015!.

cr
 
Upvote 0
chazrab said:
Hi Dave - sorry I'm late getting back to you. I copied your code, ran it, and it generated run time errors.

Here's the code I'm using with your changes:
Click to expand...

Hi,
You have not fully copied code I posted & changes you have made probably contributing to the errors you are getting

Try copying ALL of this code (updated to search only Column D) without attempting any changes & see if it will now do what you want

VBA 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 rng Is Nothing Then
                    Set rng = ws.Cells(c.Row, 1)
                Else
                    Set rng = Union(ws.Cells(c.Row, 1), 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.Resize(, 7).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"
 
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
 
End Sub

Dave
 
Last edited:
Upvote 0
Hi
copied your code exactly as directed with no changes. Below are two images. One is the error dialog. The other is
the result when the OK button on the dialog is clicked.

Code: 
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)
                                  Else
                                    Set rng = Union(ws.Cells(c.Row, 1), 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.Resize(, 7).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"
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"

'commented out but  need to add this code to display results in userform  5/3/23*******************************
'CARDRESULTS.Show
'Sheets("BUDGET").Select
'Unload Me
' Application.EnableEvents = True
' Application.ScreenUpdating = True
'mycode 5/3/23*************************************
End Sub
Thanks for all your help.
cr




The code is clean without changes. The only thing that needs to be added to your code is to display the search results
in a userform which I commented on below but not used in running.
 

Attachments

  • FIRST ERROR GENERATED FROM YOUR CODE INTACT WITH NO CHANGES.png
    FIRST ERROR GENERATED FROM YOUR CODE INTACT WITH NO CHANGES.png
    45.5 KB · Views: 11
  • BLANK FORM RESULT WHRN OK BTN ON ERROR DIALOG.png
    BLANK FORM RESULT WHRN OK BTN ON ERROR DIALOG.png
    59.5 KB · Views: 11
Upvote 0
can you comment out this line & then show me the line code errors on please

VBA Code: 
On Error GoTo myerror

Dave
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
This is an Excel to Access porting issue - Is it possible to convert an Excel VBA FIND method to work correctly in and with Access's VBA ?
4 5 6
Replies
50
Views
1K
Trebor76
T
C
  • Question
Using the Find method to copy 4 cell values above Find = X to another sheet for every value of X found in a column
Replies
6
Views
350
chazrab
C
C
  • Question
Using the FIND method with AND/OR operators. Possible?
Replies
1
Views
370
chazrab
C
N
  • Solved
Copy headers across sheets no longer works.
Replies
7
Views
412
NoSparks
N
C
  • Locked
  • Question
USING FIND METHOD WITH A VARIABLE TO FIND A STRING
Replies
5
Views
682
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,849
Messages
6,121,922
Members
449,056
Latest member
denissimo

Share this page

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
Back
Top