Need assitance with macro

[ayk5473]

Hi Folks,

So I have an macro code which searches through "column C" for specific keywords and moves it to "Sheet2" the whole row if it matches the keyword. Example: I made the code to move the whole row if there is a keywords such as "town, county, city, state, etc" I did this because I have over 100,000 data and need to filter through only government entities which might contain words like county, town, city, etc

However, now I am facing a 2nd problem which is on Sheet2 contains companies who have keywords such as "town, city, etc" and would like them removed. Example: There might a company "ABC Township Inc"

What I would like to do is create a 2nd macro to remove these keywords from "Sheet2". Is there a code that can help me with this. Thank you so for much your time and effort folks.

 

[Truiz]

You want to remove the Keyword from the string or want to delete the cell that contains that keyword?

 

[virpericulosus]

This removes cells with town or city. I think it has an issue with repeated cells so that's why it's duplicated.

Sub removeTown()


Dim val As Range


For Each val In ActiveSheet.UsedRange.Columns("A").Cells
    If val Like "*town*" Or val Like "*city*" Then
        val.Delete Shift:=xlUp
    End If
    Next


For Each val In ActiveSheet.UsedRange.Columns("A").Cells
    If val Like "*town*" Or val Like "*city*" Then
        val.Delete Shift:=xlUp
    End If
    Next


End Sub

 

[virpericulosus]

Sounds like a loop through the values like I proposed might be inefficient for large data sets:
https://stackoverflow.com/questions...-row-if-cell-doesnt-contain/16901714#16901714

But at least this loop is better than the last one I posted:

Sub removeTown()

Dim val As Range
Dim rng As Range


For Each val In ActiveSheet.UsedRange.Columns("A").Cells
    If val Like "*town*" Or val Like "*city*" Then
        val.Clear
    End If
    Next
    
Set rng = Range("A1").End(xlUp).SpecialCells(xlCellTypeBlanks)
rng.Rows.Delete Shift:=xlShiftUp


End Sub

 

[tonyyy]

ayk5473,

Welcome to the Board.

It would help us help you if you posted your code along with a representative sample of your data. Please see the links in my signature on how to do both.

Cheers,

tonyyy

 

[ayk5473]

ayk5473,

Welcome to the Board.

It would help us help you if you posted your code along with a representative sample of your data. Please see the links in my signature on how to do both.

Cheers,

tonyyy

Hi Tony, thank you so much for responding back fast guys. Essentially I have this code

Sub Foo()
Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split("commonwealth,state,city,town,county,village,hamlet,borough,university,college,Alabama,Alaska,Arizona,Arkansas,California,Colorado,Connecticut,Delaware,Florida,Georgia,Hawaii,Idaho,Illinois,Indiana,Iowa,Kansas,Kentucky,Louisiana,Maine,Maryland,Massachusetts,Michigan,Minnesota,Mississippi,Missouri,Montana,Nebraska,Nevada,New Hampshire,New Jersey,New Mexico,New York,North Carolina,North Dakota,Ohio,Oklahoma,Oregon,Pennsylvania,Rhode Island,South Carolina,South Dakota,Tennessee,Texas,Utah,Vermont,Virginia,Washington,West Virginia,Wisconsin,Wyoming", ",")
For Each cell In Sheets("Sheet1").Range("D:D")
    If (Len(cell.Value) = 0) Then Exit For
        For i = 0 To UBound(aTokens)
            If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("Sheet1").Rows(cell.Row).Copy Sheets("Sheet2").Rows(iMatches)
            End If
        Next
Next
End Sub

This code has allowed me to copy the whole rows as long as it contains the those keywords in "Columns C". However, now I have a lot of unnecessary rows of data that contained these keywords in Column C. How can I make a similar code to remove these rows of data?
Example: One of the row of data that was copied to sheet2 had it under column c "Township Corporation" and I want to make a macro that removes the whole row if it matches exactly​ this keyword. I am sorry if I am being to vague

 

[ayk5473]

ayk5473,

Welcome to the Board.

It would help us help you if you posted your code along with a representative sample of your data. Please see the links in my signature on how to do both.

Cheers,

tonyyy

Hi Tony, thank you everyone for responding very quickly. I understand it is hard to relay the message through words but essentially I have macro (posted below) that looks for the keywords in Sheet1/column D (I know I stated C earlier, apologize for the mistake) and if it matches the keyword then it copies the whole row into Sheet2.

Sub Foo()
Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split("commonwealth,state,city,town,county,village,hamlet,borough,university,college,Alabama,Alaska,Arizona,Arkansas,California,Colorado,Connecticut,Delaware,Florida,Georgia,Hawaii,Idaho,Illinois,Indiana,Iowa,Kansas,Kentucky,Louisiana,Maine,Maryland,Massachusetts,Michigan,Minnesota,Mississippi,Missouri,Montana,Nebraska,Nevada,New Hampshire,New Jersey,New Mexico,New York,North Carolina,North Dakota,Ohio,Oklahoma,Oregon,Pennsylvania,Rhode Island,South Carolina,South Dakota,Tennessee,Texas,Utah,Vermont,Virginia,Washington,West Virginia,Wisconsin,Wyoming", ",")
For Each cell In Sheets("Sheet1").Range("D:D")
    If (Len(cell.Value) = 0) Then Exit For
        For i = 0 To UBound(aTokens)
            If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("Sheet1").Rows(cell.Row).Copy Sheets("Sheet2").Rows(iMatches)
            End If
        Next
Next
End Sub

Now here is the problem; all went well but of course it also copied a whole list of rows that do not belong there but had the keyword such as "Township County Incorporation" etc. Now what I want is to create a macro which will remove these specific keywords from the Sheet2. I apologize ahead of time if I am being vague. Thank you so much for all your assistance.

 

[Truiz]

When you say remove the specific Keywords I ask again... You want to remove the Keyword from the string or want to delete the cell that contains that keyword?

This code will delete the row were the keyword has been found.

[/COLOR]Sub blabla()

lrow = ActiveSheet.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row
    
For iCntr = lrow To 1 Step -1
  Select Case True
  Case LCase(Cells(iCntr, "D")) Like "*town*"
    Rows(iCntr).Delete
  Case LCase(Cells(iCntr, "D")) Like "*county*"
    Rows(iCntr).Delete
  Case LCase(Cells(iCntr, "D")) Like "*city*"
    Rows(iCntr).Delete
  Case LCase(Cells(iCntr, "D")) Like "*state*"
    Rows(iCntr).Delete
  'add as many cases as keywords you have
    
  End Select
Next

End Sub[COLOR=#333333]

 

[Fluff]

@Truiz
My take on this, is that the OP does not want to remove the keywords themselves, but wants to delete business/organisations etc that include the keyword.
So Chippenham Town Council would remain as it is a government organisation, but Chippenham Town Rowing Club should be deleted.

 

[ayk5473]

When you say remove the specific Keywords I ask again... You want to remove the Keyword from the string or want to delete the cell that contains that keyword?

This code will delete the row were the keyword has been found.

Sub blabla()

lrow = ActiveSheet.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row
    
For iCntr = lrow To 1 Step -1
  Select Case True
  Case LCase(Cells(iCntr, "D")) Like "*town*"
    Rows(iCntr).Delete
  Case LCase(Cells(iCntr, "D")) Like "*county*"
    Rows(iCntr).Delete
  Case LCase(Cells(iCntr, "D")) Like "*city*"
    Rows(iCntr).Delete
  Case LCase(Cells(iCntr, "D")) Like "*state*"
    Rows(iCntr).Delete
  'add as many cases as keywords you have
    
  End Select
Next

End Sub

Needed the whole row to be gone, so this should work. Will update you asap; thank you so much. Saved my life