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

 

[jmacleary]

Hi there. The easiest way to do this is with a worksheet change event handler. Put the below code into the worksheet code area (right-click on the worksheet tab and select View Code).

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "A1" Then
    SearchForString (Target.Text)
End If

End Sub

Then change the searchforstring as follows:

Sub SearchForString(LSearchValue As String)
 
Dim RefCount As Integer
 
    ' LSearchValue = InputBox("Please enter a value to search for.", "Enter value") & "*" not needed as the value is passed in
    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]

Thank JM unfortunately I am getting the error msg “wrong number of arguments or invalid property assignment”

 

[Fluff]

Cross posted https://www.excelforum.com/excel-programming-vba-macros/1259326-trigger-macro-with-cell-text.html

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[andre30331]

Noted.. Sorry.

 

[jmacleary]

Thank JM unfortunately I am getting the error msg “wrong number of arguments or invalid property assignment”

I got it a bit wrong, replace A1 with $A$1 in the worksheet change subroutine. Once that is done, it works fine for me.

 

[andre30331]

I got it a bit wrong, replace A1 with $A$1 in the worksheet change subroutine. Once that is done, it works fine for me.

Hi JM thank you so much this seems to be working now. But after using the code I have found a flaw. After running the script, what I am having to do is rename Sheet2 and create a new sheet2 before I can search for my next set of data.

Is there a way to adjust the code to have the script rename Sheet2 where the data is being copied to the same name of the triggered search criteria and populate a new sheet named sheet2?

Example: If I am searching for A-052 located on sheet1, sheet2 would be renamed to A-052 and a new Sheet2 would be populated in the workbook so I could rapidly continue to search instead of having to stop searching to rename and generate a new sheet2.

 

[jmacleary]

Glad to see it works. Replace your searchforstring with this code and it will do what you want, but be careful as some search strings may be invalid for a sheet name.

Sub SearchForString(LSearchValue As String)
 
Dim RefCount As Integer
 
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = LSearchValue
    Sheets("Sheet1").Select
    ' LSearchValue = InputBox("Please enter a value to search for.", "Enter value") & "*" not needed as the value is passed in
    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
End Sub

I'm a bit rushed atm, but if you want it expanded to include error trapping with the ability to enter an alternative sheet name let me know and I'll do it tomorrow am (UK time).

 

[andre30331]

Glad to see it works. Replace your searchforstring with this code and it will do what you want, but be careful as some search strings may be invalid for a sheet name.

Sub SearchForString(LSearchValue As String)
 
Dim RefCount As Integer
 
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = LSearchValue
    Sheets("Sheet1").Select
    ' LSearchValue = InputBox("Please enter a value to search for.", "Enter value") & "*" not needed as the value is passed in
    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
End Sub

I'm a bit rushed atm, but if you want it expanded to include error trapping with the ability to enter an alternative sheet name let me know and I'll do it tomorrow am (UK time).

Awesome!!! Thanks again I will try this for now but I would love to have the trapping option added when you have a chance to update the code. Thanks again J

 

[jmacleary]

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