Amend search userform to search another file.

[danbates]

Hi,

I have this code that searches for data entry of the process order entered in textbox1.

What I would like is to expand the search to include previous years entries which are on another file and numerous worksheets.

This is the other file: C:\Users\Dell\Desktop\PO Entry Copy.xlsm

and the worksheet names are: 2017, 2018, 2019, 2020 up to 2025.

Here is the 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("Changeover Form")
    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

 

[NdNoviceHlp]

Seems like this would work...

Private Sub CommandButton1_Click()
Dim at As Long, LR As Long, x As Long, j As Long, val As Double
Dim FilDir As Object, FSO As Object, Cnt As Integer
If TextBox1.Value = "" Or TextBox1.Value = "ENTER THE PROCESS ORDER NUMBER HERE" Then
MsgBox "Please enter a Process Order number!"
Exit Sub
End If
On Error GoTo Erfix
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set FSO = CreateObject("scripting.filesystemobject")
'***change File path to your file
Set FilDir = FSO.GetFile("C:\Users\Dell\Desktop\PO Entry Copy.xlsm")
Workbooks.Open FileName:=FilDir
For Cnt = 2017 To 2025
val = TextBox1
With Sheets(CStr(Cnt))
    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 Cnt
Erfix:
Workbooks(FilDir.Name).Close SaveChanges:=False
Set FilDir = Nothing
Set FSO = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

HTH. Dave