0

It needs to search Key word in the Column.

If its Found The same key word needs to updated next column for the Found Rows

I'm trying to write a code that searches List of Key word in my excel worksheet column "B" and then If The Key word found, Group the All Found Rows updated Same key word Next Column.

There are lots of occurrences of the particular word in the worksheet. All I want to do is to search for the these occurrences and then Group the all rows that contains those words. My problem is that I'm not sure what loop structure to use. Below is the code I'm using.

Sub TestDeleteRows()
    Dim rFind As Range
    Dim rDelete As Range
    Dim strSearch As String
    Dim sFirstAddress As String
    'Dim SearchRange As Range

    'Set SearchRange = ThisWorkbook.Worksheets("KeyWords").Range("A1:A5")

    strSearch = "Password"
    Set rDelete = Nothing

    Application.ScreenUpdating = False

    With Sheets("Tags").Columns("B:B")
        Set rFind = .Find(strSearch, LookIn:=xlValues, _
        LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
        If Not rFind Is Nothing Then
            sFirstAddress = rFind.Address
            Do
                If rDelete Is Nothing Then
                    Set rDelete = rFind
                Else
                    Set rDelete = Application.Union(rDelete, rFind)
                End If
                Set rFind = .FindNext(rFind)
            Loop While Not rFind Is Nothing And rFind.Address <> sFirstAddress

            rDelete.Offset(rDelete, 1).Value = strSearch 'I am not getting the output Hear
        End If
    End With
    Application.ScreenUpdating = True
End Sub
braX
  • 11,506
  • 5
  • 20
  • 33
Chandra
  • 3
  • 5
  • Try this `rDelete.Offset(, 1).Value = strSearch` – Siddharth Rout Nov 21 '19 at 05:27
  • Thank you!! For your Grate Help, and How can i assagine the list of Key words, Ex I have some 50 Key word, If i wanted Search all Key words, If found I need to mark the next that column found Key word. – Chandra Nov 21 '19 at 05:33
  • couple of ways to do it. Store the keywords in a range and then transfer the keywords to an array. Finally loop through the array and use those keywords – Siddharth Rout Nov 21 '19 at 05:36
  • Maybe use AutoFilter. You can set a value for the second column in one go. [This](https://stackoverflow.com/q/58889516/9758194) is a question I recently asked myself, but will show you exactly how you can do what you need. – JvdV Nov 21 '19 at 06:03
  • can any one Help on the Store the keywords in a range and then transfer the keywords to an array. Finally loop through the array.. How i can Upload the Excel Sample file? – Chandra Nov 21 '19 at 12:14
  • @Siddharth Rout Thanks for you Input and help ..can you please Explain VBA how to Store the keywords in a range and then transfer the keywords to an array. Finally loop through the array I know One String to find, I have List of Strings like >100, Once its done Search with strSearch = "Password", Next needs take strSearch = "XYZ", Then strSearch = "ABC" then So on.. – Chandra Nov 24 '19 at 17:24
  • https://stackoverflow.com/questions/37689847/creating-an-array-from-a-range-in-vba – Siddharth Rout Nov 24 '19 at 17:47
  • @Siddharth Rout Thanks for you Input and help, I have done Some changes But I am Getting the Numbers, Instead Of String below Is my Code- – Chandra Nov 25 '19 at 05:38
  • Dim dat As Variant Dim rng As Range Dim i As Long Set rng = ThisWorkbook.Worksheets("KeyWords").Range("A1:A7") dat = rng.Value For i = LBound(dat, 1) To UBound(dat, 1) strSearch = i Set rDelete = Nothing Application.ScreenUpdating = False With Sheets("Tags").Columns("B:B") Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False) If Not rFind Is Nothing Then sFirstAddress = rFind.Address Do – Chandra Nov 25 '19 at 05:45
  • If rDelete Is Nothing Then Set rDelete = rFind Else Set rDelete = Application.Union(rDelete, rFind) End If Set rFind = .FindNext(rFind) Loop While Not rFind Is Nothing And rFind.Address <> sFirstAddress rDelete.Offset(, 1).Value = strSearch End If End With Next Application.ScreenUpdating = True End Sub – Chandra Nov 25 '19 at 05:45

0 Answers0