1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

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

Discussion in 'Business Applications' started by Exchanging, Jan 17, 2013.

Thread Status:
Not open for further replies.
Advertisement
  1. Exchanging

    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
     
  2. s1l3nced

    s1l3nced

    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)"
     
  3. Exchanging

    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!
     

    Attached Files:

  4. s1l3nced

    s1l3nced

    Joined:
    Jan 14, 2013
    Messages:
    21
    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
     
  5. Exchanging

    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!
     
  6. s1l3nced

    s1l3nced

    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.
     
  7. Exchanging

    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!:)
     
  8. bomb #21

    bomb #21

    Joined:
    Jul 1, 2005
    Messages:
    8,546
    Sorry, I've kind of "retired" now. :eek:

    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
     
  9. s1l3nced

    s1l3nced

    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.
     
  10. Exchanging

    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!
     
  11. bomb #21

    bomb #21

    Joined:
    Jul 1, 2005
    Messages:
    8,546
    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.
     
  12. Exchanging

    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.
     
  13. bomb #21

    bomb #21

    Joined:
    Jul 1, 2005
    Messages:
    8,546
    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? :)
     
  14. s1l3nced

    s1l3nced

    Joined:
    Jan 14, 2013
    Messages:
    21
    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?
     
  15. DeeMac330

    DeeMac330

    Joined:
    Jan 21, 2013
    Messages:
    1
    Sorry to open up this question... I'm trying to use this macro to extend to column 17 (Q). Can someone assist? Thanks
     
  16. Sponsor

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 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1085670

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice