I'm going insane with this,
I'm trying to create a macro that allows me to firstly select a list of cell values (collumn/list) using application input (all different values.) we will call these my criteria.
I then need to search a list of data (collumn B) for any cells that match the criteria list, I then need the macro to copy the rows in which the matches have been made, copy them and then paste to worksheet "PREADVICE_SUMMARY"
I am quite new to this and may be being ambitious with trying to create something with such flexibility.
any assistance is appreciated
I'm trying to create a macro that allows me to firstly select a list of cell values (collumn/list) using application input (all different values.) we will call these my criteria.
I then need to search a list of data (collumn B) for any cells that match the criteria list, I then need the macro to copy the rows in which the matches have been made, copy them and then paste to worksheet "PREADVICE_SUMMARY"
I am quite new to this and may be being ambitious with trying to create something with such flexibility.
any assistance is appreciated
VBA Code:
Private Sub CommandButton21_Click()
Dim criteria As Range
Dim srchloc As Range
'specify list of cell values to search for match'
criteria = Application.InputBox(prompt = "Select cells as search criteria", Type:=8)
'specify list of cells to loop through.'
srchloc = Application.InputBox(prompt = "select cell range to search through", typ:=8)
'if either input is left blank exit.'
If criteria = "" Then Exit Sub
If srchloc = "" Then Exit Sub
Application.ScreenUpdating = False
Dim xRow&, NextRow&, LastRow&
NextRow = Sheets("PREADVICE_SUMMARY").Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For xRow = 1 To LastRow
If WorksheetFunction.CountIf(Rows(xRow), "*" & criteria & "*") > 0 Then
Rows(xRow).Copy Sheets("PREADVICE_SUMMARY").Rows(NextRow)
NextRow = Sheets("PREADVICE_SUMMARY").Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
End If
Next xRow
Application.ScreenUpdating = True
MsgBox "Macro is complete, " & NextRow - 2 & " rows containing" & vbCrLf & _
"''" & myWord & "''" & " were copied to Sheet2.", 64, "Done"
End Sub
Last edited by a moderator: