Excel search macro almost solved by an earlier bomb#21 post

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Exchanging

Thread Starter
Joined
Jan 16, 2013
Messages
7
Hi there

I am a bit of a Macro novice, but found the below macro was exactly what I needed to search one tab by key words and display asscoiated rows containing that data in another tab.

The problem I have, is that it searches columns A to L, however, I need it search an extra column to M. I have tried all sorts but can't crack it as not an expert on deciphering the code. Can any PLEASE tell me what I need to tweak in the code to extend the search to column M?

Any help sincerely appreciated as I've tried everything! :confused:

Thanks


Sub test()
If ActiveSheet.Name <> "Query Directory" Then Exit Sub
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Sheets("Search results").Range("3:10000").Delete
SearchTerm = Application.InputBox("What are you looking for?")
Application.ScreenUpdating = False
Range("L1") = SearchTerm
Range("L2:L" & LastRow).FormulaR1C1 = _
"=IF(ISERR(SEARCH(R1C12,RC[-11]&RC[-10]&RC[-9]&RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1])),0,1)"
If WorksheetFunction.CountIf(Columns(12), 1) = 0 Then
Columns(12).Delete
Application.ScreenUpdating = True
MsgBox "None found."
Else
For Each Cell In Range("A2:A" & LastRow)
If Cell.Offset(, 11) = 1 Then
Cell.Resize(, 11).Copy Sheets("Search Results").Range("A" & Rows.Count).End(xlUp).Offset(1)
x = x + 1
End If
Next Cell
Columns(12).Delete
Application.ScreenUpdating = True
If x = 1 Then
MsgBox "1 matching record was copied to Search Results tab."
Else
MsgBox x & " matching records were copied to Search Results tab."
End If
End If
End Sub
 
Joined
Jan 14, 2013
Messages
21
I'm not sure if this would work, or not... I can't seem to test it..It's giving me error: "Compile Error: Expected End Sub"... maybe if you provide a sample spreadsheet I can use that (remove any sensitive data, of course). Anyways I'll attach the code I modified, try it out and let me know.

Code:
Sub test()
 If ActiveSheet.Name <> "Query Directory" Then Exit Sub
 LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
 Sheets("Search results").Range("3:10000").Delete
 SearchTerm = Application.InputBox("What are you looking for?")
 Application.ScreenUpdating = False
 Range("L1") = SearchTerm
 Range("L2:M" & LastRow).FormulaR1C1 = _
 "=IF(ISERR(SEARCH(R1C13,RC[-12]&RC[-11]&RC[-10]&RC[-9]&RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1])),0,1)"
 If WorksheetFunction.CountIf(Columns(12), 1) = 0 Then
 Columns(12).Delete
 Application.ScreenUpdating = True
 MsgBox "None found."
 Else
 For Each Cell In Range("A2:A" & LastRow)
 If Cell.Offset(, 11) = 1 Then
 Cell.Resize(, 11).Copy Sheets("Search Results").Range("A" & Rows.Count).End(xlUp).Offset(1)
 x = x + 1
 End If
 Next Cell
 Columns(12).Delete
 Application.ScreenUpdating = True
 If x = 1 Then
 MsgBox "1 matching record was copied to Search Results tab."
 Else
 MsgBox x & " matching records were copied to Search Results tab."
 End If
 End If
Edit: I'm no expert on this matter myself.. how I came up with this slight modification: I noticed the letter "L" in Line 8:
Code:
 Range("L2:[B]L[/B]" & LastRow).FormulaR1C1 = _
I decided to change the "L" to "M" like this:
Code:
Range("L2:[B]M[/B]" & LastRow).FormulaR1C1 = _
I also noticed, the number 12 on Line 9:
Code:
"=IF(ISERR(SEARCH(R1C[B]12[/B],RC[-11]&RC[-10]&RC[-9]&RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1])),0,1)"
Note: The letter "L", is the 12th letter in the alphabet. I see that the highest number provided was 12 on Line 9.. see again here:
Code:
 "=IF(ISERR(SEARCH([B]R1C12[/B],RC[-11]&RC[-10]&RC[-9]&RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1])),0,1)"
So I modified Line 9 to this:
Code:
"=IF(ISERR(SEARCH([B]R1C13,RC[-12]&[/B]RC[-11]&RC[-10]&RC[-9]&RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1])),0,1)"
 

Exchanging

Thread Starter
Joined
Jan 16, 2013
Messages
7
Hi there

Thanks for your help, much appreciated. I tried your suggestion but unfortunately it error'd. I have attached a sample spreadsheet with the original code as suggested.

Thanks again!
 

Attachments

Joined
Jan 14, 2013
Messages
21
Hi there

Thanks for your help, much appreciated. I tried your suggestion but unfortunately it error'd. I have attached a sample spreadsheet with the original code as suggested.

Thanks again!
Sorry about that. I forgot to add "End Sub" to the end of the file. Try this:

Sub test()
If ActiveSheet.Name <> "Query Directory" Then Exit Sub
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Sheets("Search results").Range("3:10000").Delete
SearchTerm = Application.InputBox("What are you looking for?")
Application.ScreenUpdating = False
Range("L1") = SearchTerm
Range("L2:M" & LastRow).FormulaR1C1 = _
"=IF(ISERR(SEARCH(R1C13,RC[-12]&RC[-11]&RC[-10]&RC[-9]&RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1])),0,1)"
If WorksheetFunction.CountIf(Columns(12), 1) = 0 Then
Columns(12).Delete
Application.ScreenUpdating = True
MsgBox "None found."
Else
For Each Cell In Range("A2:A" & LastRow)
If Cell.Offset(, 11) = 1 Then
Cell.Resize(, 11).Copy Sheets("Search Results").Range("A" & Rows.Count).End(xlUp).Offset(1)
x = x + 1
End If
Next Cell
Columns(12).Delete
Application.ScreenUpdating = True
If x = 1 Then
MsgBox "1 matching record was copied to Search Results tab."
Else
MsgBox x & " matching records were copied to Search Results tab."
End If
End If
End Sub
 

Exchanging

Thread Starter
Joined
Jan 16, 2013
Messages
7
Hi

Unfortunately it still doesnt work, it shows all the data under the search results tab and replaces the text in the final column (L) with a formula from the code (=IF(ISERR(SEARCH($L$1,#REF!&B2&C2&D2&E2&F2&G2&H2&I2&J2&K2&#REF!)),0,1))

Did you see the sample I sent over? Thanks again!
 
Joined
Jan 14, 2013
Messages
21
Try this:
Sub test()
If ActiveSheet.Name <> "Query Directory" Then Exit Sub
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Sheets("Search results").Range("3:10000").Delete
SearchTerm = Application.InputBox("What are you looking for?")
Application.ScreenUpdating = False
Range("M1") = SearchTerm
Range("M2:M" & LastRow).FormulaR1C1 = _
"=IF(ISERR(SEARCH(R1C13,RC[-12]&RC[-11]&RC[-10]&RC[-9]&RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1])),0,1)"
If WorksheetFunction.CountIf(Columns(13), 1) = 0 Then
Columns(13).Delete
Application.ScreenUpdating = True
MsgBox "None found."
Else
For Each Cell In Range("A2:A" & LastRow)
If Cell.Offset(, 12) = 1 Then
Cell.Resize(, 12).Copy Sheets("Search Results").Range("A" & Rows.Count).End(xlUp).Offset(1)
x = x + 1
End If
Next Cell
Columns(13).Delete
Application.ScreenUpdating = True
If x = 1 Then
MsgBox "1 matching record was copied to Search Results tab."
Else
MsgBox x & " matching records were copied to Search Results tab."
End If
End If
End Sub


Let me know how that goes.
 

Exchanging

Thread Starter
Joined
Jan 16, 2013
Messages
7
That works, you are a legend! I have spent so long trying to crack this one. Sincerely appreciate your help!:)
 
Joined
Jul 1, 2005
Messages
8,546
Sorry, I've kind of "retired" now. :eek:

Exchanging said:
The problem I have, is that it searches columns A to L, however, I need it search an extra column to M.
Sub test()
If ActiveSheet.Name <> "Query Directory" Then Exit Sub
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Sheets("Search results").Range("A:M").Delete
SearchTerm = Application.InputBox("What are you looking for?")
Application.ScreenUpdating = False
Columns(15).Delete
Range("O1") = SearchTerm
Range("O2:O" & LastRow).FormulaR1C1 = _
"=IF(ISERR(SEARCH(R1C15,RC[-14]&RC[-13]&RC[-12]&RC[-11]&RC[-10]&RC[-9]&RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2])),0,1)"
If WorksheetFunction.CountIf(Columns(15), 1) = 0 Then
Columns(15).Delete
Application.ScreenUpdating = True
MsgBox "None found."
Else
numres = WorksheetFunction.CountIf(Columns(15), 1)
For Each Cell In Range("A2:A" & LastRow)
If Cell.Offset(, 14) = 1 Then
Cell.Resize(, 14).Copy Sheets("Search Results").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next Cell
Columns(15).Delete
Application.ScreenUpdating = True
If numres = 1 Then
MsgBox "1 matching record was copied to Search Results tab."
Else
MsgBox numres & " matching records were copied to Search Results tab."
End If
End If
End Sub
 
Joined
Jan 14, 2013
Messages
21
In all honesty this was one of my first assignments with Excel. I was basically working in the dark with my brain and two hands. I'm sincerely glad I could help you.
 

Exchanging

Thread Starter
Joined
Jan 16, 2013
Messages
7
I missed your post and s1l3nced managed to crack it! Thanks very much though as it was your original post to create the search code in the first place. I looked at many ideas on the web and yours was the best by far - you should come out of retirement!
 

Exchanging

Thread Starter
Joined
Jan 16, 2013
Messages
7
None taken, completely my fault, I was extended to include column L but, you are right, I incorrectly typed M! Thanks again.
 
Joined
Jul 1, 2005
Messages
8,546
None taken, completely my fault, I was extended to include column L but, you are right, I incorrectly typed M! Thanks again.
My comment was @ s1l3nced though. :D

"Debugging 101" -- in the VBA module, click anywhere in the code. Then press F8 to fire the code one line at a time ("stepping through"). When you've done that for the line:

Range("O2:O" & LastRow).FormulaR1C1 = _
"=IF(ISERR(SEARCH(R1C15,RC[-14]&RC[-13]&RC[-12]&RC[-11]&RC[-10]&RC[-9]&RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2])),0,1)"


, STOP. Then switch to the worksheet to analyse the syntax of the formulas created in column O. Dig? :)
 
Joined
Jan 14, 2013
Messages
21
No offence intended but, if the aim is "to extend the search TO column M" (i.e. inclusive) then building the formulas IN column M won't cut it. That's the way I read it, anyway.
Using my logic I assumed that since the letter "M" is one letter ahead of "L", I went ahead and incrimented every number 12 I could. I figured since you used 12 for L, I'll use 13 for M. That's just how my brain works. As I said, this is literally, my first attempt at any type of Excel coding. I do fairly well in Programming Logic, so I figured I would attempt this.

Edit: I think I understand what you're saying. So basically, in this case, I would just incriment by +2. Correct? Or am I wrong?
 
Joined
Jan 21, 2013
Messages
1
Try this:
Sub test()
If ActiveSheet.Name <> "Query Directory" Then Exit Sub
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Sheets("Search results").Range("3:10000").Delete
SearchTerm = Application.InputBox("What are you looking for?")
Application.ScreenUpdating = False
Range("M1") = SearchTerm
Range("M2:M" & LastRow).FormulaR1C1 = _
"=IF(ISERR(SEARCH(R1C13,RC[-12]&RC[-11]&RC[-10]&RC[-9]&RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1])),0,1)"
If WorksheetFunction.CountIf(Columns(13), 1) = 0 Then
Columns(13).Delete
Application.ScreenUpdating = True
MsgBox "None found."
Else
For Each Cell In Range("A2:A" & LastRow)
If Cell.Offset(, 12) = 1 Then
Cell.Resize(, 12).Copy Sheets("Search Results").Range("A" & Rows.Count).End(xlUp).Offset(1)
x = x + 1
End If
Next Cell
Columns(13).Delete
Application.ScreenUpdating = True
If x = 1 Then
MsgBox "1 matching record was copied to Search Results tab."
Else
MsgBox x & " matching records were copied to Search Results tab."
End If
End If
End Sub


Let me know how that goes.
Sorry to open up this question... I'm trying to use this macro to extend to column 17 (Q). Can someone assist? Thanks
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Staff online

Members online

Top