Trigger Macro with cell text

[andre30331]

Hello,

Here is my issue I currently have code that, when activated it displays an input box for the user to enter search criteria. Once entered and the script is ran it searches sheet1 and paste the findings onto sheet2. Also the current code when pasting the result to Sheet2 begins pasting at row two(2) instead of row one(1) and I cannot seem to fix it but this is not the main issue.

The main issue:
What I would like this code to do is, instead of having an “input box” populate when the Macro activates is use a predetermined cell on sheet1 lets say cell A1 to act as a trigger to run the Marco and search for the text entered into cell A1. Having this option would allow the user to search for any number of items much quicker and look to sheet2 for the results without having to repeatedly navigate into developer options to run the macro. Thanks in advance for helping. Here is the current code I am using:

Sub SearchForString()

Dim LSearchValue As String
Dim RefCount As Integer

LSearchValue = InputBox("Please enter a value to search for.", "Enter value") & "*"
RefCount = Application.WorksheetFunction.CountIf(Sheet1.Range("A:L"), LSearchValue) - 1
Range("E:E").Activate
For Counter = 0 To RefCount Step 1
With Columns("A:L").Find(What:=LSearchValue, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
.EntireRow.Copy Destination:=Worksheets("sheet2").Range("A65536").End(xlUp).Offset(1, 0)
.Activate
End With
Next
End Sub

 

[andre30331]

Hi there. Sorry I didnt get back sooner - try this:

Sub SearchForString(LSearchValue As String)
 
Dim RefCount As Integer
Dim SheetName As String
    Sheets.Add After:=Sheets(Sheets.Count)
    SheetName = LSearchValue
    On Error GoTo badname
dosheet:
    ActiveSheet.Name = SheetName
    On Error GoTo 0
    Sheets("Sheet1").Select
    RefCount = Application.WorksheetFunction.CountIf(Sheet1.Range("A:L"), LSearchValue) - 1
    Range("E:E").Activate
    For Counter = 0 To RefCount Step 1
        With Columns("A:L").Find(What:=LSearchValue, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            .EntireRow.Copy Destination:=Worksheets(SheetName).Range("A65536").End(xlUp).Offset(1, 0)
            .Activate
        End With
    Next
    Exit Sub
badname:
On Error GoTo -1
    On Error GoTo badname
    SheetName = InputBox(SheetName + " - is not valid as a sheet name (it already exists or is not allowed by excel) so please enter a name to use", "Enter name")
    GoTo dosheet
End Sub

Thank you!!

 

[andre30331]

Thank you!!

The code works as expected but here is the issue. If I search for A100 and A100 already exist in the workbook you are then prompted to enter another name for the new sheet of result.

Let’s say I input A200 as a result of being prompted to do so. The problem is the results on the new sheet are A100 which we now know we already have because we’ve been prompted to look for something else. Can we have to macro search for the new information supplied when this happens instead of returning the original search results with only a new sheet name?

 

[jmacleary]

Yes, I did notice this - I assumed you wanted to run the macro again for the same search. However, the code below will do what you want (i.e. it will ask for a new name and search on that instead).

Sub SearchForString(LSearchValue As String)
 
Dim RefCount As Integer
Dim SheetName As String
    Sheets.Add After:=Sheets(Sheets.Count)
    On Error GoTo badname
dosheet:
    ActiveSheet.Name = LSearchValue
    On Error GoTo 0
    Sheets("Sheet1").Select
    RefCount = Application.WorksheetFunction.CountIf(Sheet1.Range("A:L"), LSearchValue) - 1
    Range("E:E").Activate
    For Counter = 0 To RefCount Step 1
        With Columns("A:L").Find(What:=LSearchValue, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            .EntireRow.Copy Destination:=Worksheets(LSearchValue).Range("A65536").End(xlUp).Offset(1, 0)
            .Activate
        End With
    Next
    Exit Sub
badname:
On Error GoTo -1
    On Error GoTo badname
    LSearchValue = InputBox(LSearchValue + " - is not valid as a sheet name (it already exists or is not allowed by excel) so please enter a name to use", "Enter name")
    GoTo dosheet
End Sub

 

[andre30331]

Yes, I did notice this - I assumed you wanted to run the macro again for the same search. However, the code below will do what you want (i.e. it will ask for a new name and search on that instead).

Sub SearchForString(LSearchValue As String)
 
Dim RefCount As Integer
Dim SheetName As String
    Sheets.Add After:=Sheets(Sheets.Count)
    On Error GoTo badname
dosheet:
    ActiveSheet.Name = LSearchValue
    On Error GoTo 0
    Sheets("Sheet1").Select
    RefCount = Application.WorksheetFunction.CountIf(Sheet1.Range("A:L"), LSearchValue) - 1
    Range("E:E").Activate
    For Counter = 0 To RefCount Step 1
        With Columns("A:L").Find(What:=LSearchValue, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            .EntireRow.Copy Destination:=Worksheets(LSearchValue).Range("A65536").End(xlUp).Offset(1, 0)
            .Activate
        End With
    Next
    Exit Sub
badname:
On Error GoTo -1
    On Error GoTo badname
    LSearchValue = InputBox(LSearchValue + " - is not valid as a sheet name (it already exists or is not allowed by excel) so please enter a name to use", "Enter name")
    GoTo dosheet
End Sub

JM this works great thank you again. Yet I have one last ask for this. I have a sheet with 6500 records and growing with the data search cell being A1.

My question to you is, can we have the macro scroll back to the top of the page after each search? If I search for let’s say WSP1-458 and get a hit when the search is complete I am having to manually scroll all the way back up to the top of the page from wherever the last cell having WSP1-458 was found to enter my next search data.