VBA to select multiply entries from a selected sheet.

[Tnarg100]

Hello all,

I am looking for a vba code that will give a input form with 2 drop boxes that will define the data to pull from a sheet that is specified. I have a workbook that covers the years down time, each sheet is a separate month. I will be required to select at the end of the month a particular machines downtime and copy it to an archive that we are going to start. I have found a code that does that to a point (Found it on here sorry can not remember who did it but thank you if you recognise it) but it searches the whole workbook. I would like to be able to say which sheet (month) that I want it to look at and pull the required data.


Thank you for any help.


Sub Set_Hyper1()
' Object variables
Dim wks As Excel.Worksheet
Dim rCell As Excel.Range
Dim fFirst As String
' {i} will act as our counter
Dim i As Long
' Use an input box to type in the search criteria
Dim MyVal As String
MyVal = InputBox("What are you searching for", "Search-Box", "")
' if we don't have anything entered, then exit the procedure
If MyVal = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False

i = 2
' Begin looping:
' We are checking all the Worksheets in the Workbook
For Each wks In ActiveWorkbook.Worksheets
If wks.Name <> "search" Then


' We are checking all cells, we don't need the SpecialCells method
' the Find method is fast enough
With wks.Range("C:d")
' Using the find method is faster:
' Here we are checking column "A" that only have {myVal} explicitly


Set rCell = .Find(MyVal, , , xlPart, xlByColumns, xlNext, False)
' If something is found, then we keep going
If Not rCell Is Nothing Then
' Store the first address
fFirst = rCell.Address
Do
' Link to each cell with an occurence of {MyVal}

wks.Range("A" & rCell.Row & ":R" & rCell.Row).Copy Destination:=Cells(i + 3, 2)
Set rCell = .FindNext(rCell)
i = i + 1 'Increment our counter
Loop While Not rCell Is Nothing And rCell.Address <> fFirst
End If
End With
End If
Next wks
' Explicitly clear memory
Set rCell = Nothing
' If no matches were found, let the user know
If i = 2 Then
MsgBox "The value {" & MyVal & "} was not found on any sheet", 64, "No Matches"
Cells(1, 1).Value = ""
End If
' Reset application settings
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Center
End Sub