Dim strSearchAddress As String
Private Sub CommandButton1_Click()
Dim strAddress As String
Dim strSheet As String
Dim strCell As String
Dim l As Long
Dim lLastRow As Long
Const sRESULTS As String = "Results Sheet"
For l = 0 To ListBox_Results.ListCount
If ListBox_Results.Selected(l) = True Then
strAddress = ListBox_Results.List(l, 1)
strSheet = Replace(Mid(strAddress, 1, InStr(1, strAddress, "!") - 1), "'", "")
Worksheets(strSheet).Select
Worksheets(strSheet).Range(strAddress).Select
With Worksheets(sRESULTS)
lLastRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & lLastRow).Value = Worksheets(strSheet).Range(strAddress).Value
.Range("B" & lLastRow).Value = "Item Number"
.Range("C" & lLastRow).Value = "Quantity"
.Range("D" & lLastRow).Value = "On Hand Stock Location"
.Range("E" & lLastRow).Value = Now
.Range("F" & lLastRow).Value = strAddress
End With
GoTo EndLoop
End If
Next l
EndLoop:
End Sub
Private Sub Label1_Click()
End Sub
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Dim lRow As Long
Dim lCol As Long
Dim lMaxRow As Long
Dim lMaxCol As Long
lMaxRow = 0
lMaxCol = 0
For Each ws In ActiveWorkbook.Worksheets
lRow = ws.UsedRange.Cells.Rows.Count
lCol = ws.UsedRange.Cells.Columns.Count
If lRow > lMaxRow Then lMaxRow = lRow
If lCol > lMaxCol Then lMaxCol = lCol
Next ws
strSearchAddress = Range(Cells(1, 1), Cells(lMaxRow, lMaxCol)).Address
End Sub
Private Sub TextBox_Find_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Call FindAllMatches
End Sub
Private Sub Label_ClearFind_Click()
Me.TextBox_Find.Text = ""
Me.TextBox_Find.SetFocus
End Sub
Sub FindAllMatches()
Dim FindWhat As Variant
Dim FoundCells As Variant
Dim FoundCell As Range
Dim arrResults() As Variant
Dim lFound As Long
Dim lSearchCol As Long
Dim lLastRow As Long
Dim lWS As Long
Dim lCount As Long
Dim ws As Worksheet
Dim lRow As Long
Dim lCol As Long
Dim lMaxRow As Long
Dim lMaxCol As Long
If Len(f_FindAll.TextBox_Find.Value) > 1 Then
FindWhat = f_FindAll.TextBox_Find.Value
FoundCells = FindAllOnWorksheets(Nothing, Empty, SearchAddress:=strSearchAddress, _
FindWhat:=FindWhat, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
MatchCase:=False, _
BeginsWith:=vbNullString, _
EndsWith:=vbNullString, _
BeginEndCompare:=vbTextCompare)
lCount = 0
For lWS = LBound(FoundCells) To UBound(FoundCells)
If Not FoundCells(lWS) Is Nothing Then
lCount = lCount + FoundCells(lWS).Count
End If
Next lWS
If lCount = 0 Then
ReDim arrResults(1 To 1, 1 To 8)
arrResults(1, 1) = "No Results"
Else
ReDim arrResults(1 To lCount, 1 To 8)
lFound = 1
For lWS = LBound(FoundCells) To UBound(FoundCells)
If Not FoundCells(lWS) Is Nothing Then
For Each FoundCell In FoundCells(lWS)
arrResults(lFound, 1) = FoundCell.Value
arrResults(lFound, 2) = "'" & FoundCell.Parent.Name & "'!" & FoundCell.Address(External:=False)
arrResults(lFound, 3) = FoundCell.EntireRow.Cells(3).Value
arrResults(lFound, 4) = FoundCell.EntireRow.Cells(4).Value
arrResults(lFound, 5) = FoundCell.EntireRow.Cells(5).Value
arrResults(lFound, 6) = FoundCell.EntireRow.Cells(6).Value
arrResults(lFound, 7) = FoundCell.EntireRow.Cells(7).Value
arrResults(lFound, 8) = FoundCell.EntireRow.Cells(8).Value
lFound = lFound + 1
Next FoundCell
End If
Next lWS
End If
Me.ListBox_Results.List = arrResults
Else
Me.ListBox_Results.Clear
End If
End Sub
Private Sub ListBox_Results_Click()
Dim strAddress As String
Dim strSheet As String
Dim strCell As String
Dim l As Long
For l = 0 To ListBox_Results.ListCount
If ListBox_Results.Selected(l) = True Then
strAddress = ListBox_Results.List(l, 1)
strSheet = Replace(Mid(strAddress, 1, InStr(1, strAddress, "!") - 1), "'", "")
Worksheets(strSheet).Select
Worksheets(strSheet).Range(strAddress).Select
GoTo EndLoop
End If
Next l
EndLoop:
End Sub
Private Sub CommandButton_Close_Click()
Unload Me
End Sub