Dim c As Range
Dim rng As Range
Private Sub CommandButton1_Click()
Dim strFind As String 'what to find
Dim FirstAddress As String
Dim rSearch As Range 'range to search
Dim database As Worksheet
'Worksheets("find_result").Range("A3:AP65536").ClearContents
Set database = ActiveWorkbook.Worksheets("database")
database.Activate
Set rSearch = database.Range("a3", database.Range("a65536").End(xlUp))
Dim f As Integer
strFind = Worksheets("Estimation").Range("B2").Value 'what to look for
With rSearch
Set c = .Find(strFind, LookIn:=xlValues)
If Not c Is Nothing Then 'found it
c.Select
For i = 0 To 31
Worksheets("Find_Result").Cells(3, i + 1).Value = c.Offset(0, i).Value
Next i
f = 0
FirstAddress = c.Address
Do
f = f + 1 'count number of matching records
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
If f > 1 Then
Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
Case vbOK
FindAll
Case vbCancel
'do nothing
End Select
End If
Else: MsgBox strFind & " not listed" 'search failed
End If
End With
Worksheets("database").Activate
End Sub
Sub FindAll()
Dim strFind As String 'what to find
Dim rFilter As Range 'range to search
Dim database As Worksheet
Set database = ActiveWorkbook.Worksheets("database")
database.Activate
Set rFilter = database.Range("a3", database.Range("ap65536").End(xlUp))
strFind = Worksheets("Estimation").Range("B2").Value
With Worksheets("database")
If Not .AutoFilterMode Then .Range("A3").AutoFilter
rFilter.AutoFilter Field:=1, Criteria1:=strFind
Set rng = rng.Cells.SpecialCells(xlCellTypeVisible)
j = 3
For Each c In rng
For i = 0 To 31
Worksheets("Find_Result").Cells(3, i + 1).Value = c.Offset(0, i).Value
Next i
j = j + 1
Next c
End With
Worksheets("find_result").Activate
End Sub
