Alter userform code to search multiple sheets instead of one.

[danbates]

Hi,

Please can someone help me?

I would like to alter the following code so it searches all my workbooks sheets instead of just one.

Here is my code:

Private Sub CommandButton1_Click()Dim at As Long, LR As Long, x As Long, j As Long, val As Double

If TextBox1.Value = "" Or TextBox1.Value = "ENTER THE PROCESS ORDER NUMBER HERE" Then
MsgBox "Please enter a Process Order number!"
Exit Sub
End If

val = TextBox1

With Sheets("2017")
    at = Application.CountIf(.range("A:A"), TextBox1)
    If at > 0 Then
        LR = .range("A" & Rows.Count).End(xlUp).Row
        ReDim arr(1 To LR, 1 To 5)
        j = 0
        For x = 3 To LR
            If .range("A" & x).Value = val Then
                j = j + 1
                arr(j, 1) = .range("A" & x).Value
                arr(j, 2) = .range("B" & x).Value
                arr(j, 3) = .range("C" & x)
                arr(j, 4) = Format(.range("I" & x), "dd/mm/yyyy hh:mm:ss")
                arr(j, 5) = .range("A" & x).Row
            End If
        Next
        ListBox1.List = arr
        For x = ListBox1.ListCount - 1 To 0 Step -1
            If ListBox1.List(x) = "" Then
                ListBox1.RemoveItem (x)
            End If
        Next
    Else
        MsgBox "INCORRECT DATA ENTRY" & vbCrLf & vbCrLf & "Please check your PO number and try again", vbExclamation, "Palletiser Operator"
        
        ListBox1.SetFocus


        Exit Sub
    End If
End With


End Sub

Any help would be much appreciated.

Thanks

Dan

 

[Mentor82]

Hi,
Check if that's what you're looking for.

Private Sub CommandButton1_Click()Dim at As Long, LR As Long, x As Long, j As Long, val As Double
Dim ws as worksheet

If TextBox1.Value = "" Or TextBox1.Value = "ENTER THE PROCESS ORDER NUMBER HERE" Then
MsgBox "Please enter a Process Order number!"
Exit Sub
End If

val = TextBox1

For each ws in worksheets

With ws
    Erase arr
    at = Application.CountIf(.range("A:A"), TextBox1)
    If at > 0 Then
        LR = .range("A" & Rows.Count).End(xlUp).Row
        ReDim arr(1 To LR, 1 To 5)
        j = 0
        For x = 3 To LR
            If .range("A" & x).Value = val Then
                j = j + 1
                arr(j, 1) = .range("A" & x).Value
                arr(j, 2) = .range("B" & x).Value
                arr(j, 3) = .range("C" & x)
                arr(j, 4) = Format(.range("I" & x), "dd/mm/yyyy hh:mm:ss")
                arr(j, 5) = .range("A" & x).Row
            End If
        Next
        ListBox1.List = arr
        For x = ListBox1.ListCount - 1 To 0 Step -1
            If ListBox1.List(x) = "" Then
                ListBox1.RemoveItem (x)
            End If
        Next
    Else
        MsgBox "INCORRECT DATA ENTRY" & vbCrLf & vbCrLf & "Please check your PO number and try again", vbExclamation, "Palletiser Operator"
        
        ListBox1.SetFocus


        Exit Sub
    End If
End With

Next ws

End Sub

With appreciation
Sebastian

 

[danbates]

Hi Sebastian,

Thank you for your reply.

Erase arr

The arr part of the code comes up with a compile error - Variable not defined.

Any ideas?

Thanks

Dan

 

[danbates]

Would anyone else like to help me with the error from mentor82 code?

Thanks

Dan

 

[danbates]

Just posted this problem on another forum so here is the link:

https://www.excelforum.com/excel-general/1261304-how-to-search-all-worksheets.html