Create subroutine VBA to replace keyword in a column

**william516** · 07-23-2013, 07:06 PM

It has become too time consuming to simply use the find and replace method as there are probably 100+ combinations of words that need to be found and shortened or changed when information has been copied and pasted into the worksheet page. Here is an example of what I am looking to do.

Run a subroutine once all the information has been manually imported / copied and pasted from a word document into the excel sheet "Initiating Devices"
Column (B) Is the type column. When the information is originally pasted the words are too long or need to be changed to make the countif statements on another page to work, and to fit in the cell.

Example
Smoke Detector would be replaced with "Photo"
Pull Station "Pull"
Heat Detector "Heat"
etc.......
The list could go on for a while. I have been manually using the find and replace method but it has been a slow process and not only that but I sometimes need to search for several words to replace the same word.
for example
Manual Station, Pull Station, Pull Box, Emergency Station, ...etc is all replaced with "PULL"
The problem was that originally there was no set format and the inspectors simply wrote whatever they wanted. Now I am restricting it to a drop down list, but I still need to convert all the old data into the new sheets.

So the sub would look for a word
"Smoke Detector" in column B and replace it with "Photo" for all occurrences it would find on the page. If possible could it also search for "Photo Detector", "PS,PD or other combination. I tried using the record macro method but it doesn't work the way it should and usually results in an error when run. Thanks. If someone can just get me started I can write the tons of other replacements needed later. Thanks

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://eileenslounge.com/viewtopic.php?p=317218#p317218
https://eileenslounge.com/viewtopic.php?p=316955#p316955
https://eileenslounge.com/viewtopic.php?p=316955#p316955
https://eileenslounge.com/viewtopic.php?p=316940#p316940
https://eileenslounge.com/viewtopic.php?p=316927#p316927
https://eileenslounge.com/viewtopic.php?p=317014#p317014
https://eileenslounge.com/viewtopic.php?p=317006#p317006
https://eileenslounge.com/viewtopic.php?p=316935#p316935
https://eileenslounge.com/viewtopic.php?p=316875#p316875
https://eileenslounge.com/viewtopic.php?p=316254#p316254
https://eileenslounge.com/viewtopic.php?p=316280#p316280
https://eileenslounge.com/viewtopic.php?p=315915#p315915
https://eileenslounge.com/viewtopic.php?p=315512#p315512
https://eileenslounge.com/viewtopic.php?p=315744#p315744
https://www.eileenslounge.com/viewtopic.php?p=315512#p315512
https://eileenslounge.com/viewtopic.php?p=315680#p315680
https://eileenslounge.com/viewtopic.php?p=315743#p315743
https://www.eileenslounge.com/viewtopic.php?p=315326#p315326
https://www.eileenslounge.com/viewtopic.php?f=30&t=40752
https://eileenslounge.com/viewtopic.php?p=314950#p314950
https://www.eileenslounge.com/viewtopic.php?p=314940#p314940
https://www.eileenslounge.com/viewtopic.php?p=314926#p314926
https://www.eileenslounge.com/viewtopic.php?p=314920#p314920
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

**testingcode** · 07-23-2013, 07:48 PM

Originally Posted by william516

*snip*

How about something like this:

Code:

Dim rows As Integer
Dim i As Integer

    i = 1
    Range("B1").Activate
    rows = ActiveSheet.UsedRange.rows.Count
    Application.ScreenUpdating = False
        Do

            '''Find requirements for Photo
            If ActiveCell.Value = "Photo Detector" Or ActiveCell.Value = "PS" Or ActiveCell.Value = "PD" Then
                ActiveCell.Value = "Photo"
                ActiveCell.Offset(1, 0).Activate

            '''Find requirements for Pull
            ElseIf ActiveCell.Value = "Manual Station" Or ActiveCell.Value = "Pull Station" Or ActiveCell.Value = "Pull Box" Then
                ActiveCell.Value = "Pull"
                ActiveCell.Offset(1, 0).Activate

            '''No requirements met, so move to next cell
            Else
                ActiveCell.Offset(1, 0).Activate
            End If
            
        i = i + 1

        Loop Until i > rows
        
    Range("B1").Activate

I'm still pretty new at this stuff myself. A more senior coder could probably come up with a better solution, but this should work.

**Admin** · 07-23-2013, 10:31 PM

**william516** · 07-24-2013, 07:10 AM

**Admin** · 07-24-2013, 07:56 AM

See my comments in red.

Originally Posted by william516

Wow you guys are awesome. Both things look pretty good. Can the person that posted the file above please explain how this works. I think I understand but im not 100% sure. So better to ask then screw it up.

I'm assuming that I would create another page and that would become the table for the replacements as I see in your example.

Column "G' "Searchwhat would be the keywords to look for example "smoke detector" or "Duct Detector" - Yes
Column "h" "replacewith" would be the words that it would be replacing with example "Photo" or "Duct" - Yes
Column "I" 'lookat" would be the column that the macro looks for I assume, In my page it would be column "B" or 2 - No. If you hit CTRL+H, you see an option 'Match entire cell contents'. If it is checked, lookat - 1, and if it is not, lookat - 2
I do not understand what column "J" is for "1 whole match, 2 partial match - (explanation of 1 and 2)

I also am confused on what would go in column "A" or "B" that is on your sheet - Sample data

Also I assume I would just keep writing words in both columns "G" and "H" and that would be endless poss, as long as I adjust the vba code for the range. - Yes

Thanks again for all the help. I will mess with it a little. Oh I also assume I will have to make the name of the sheet change as well to suit the VBA code. - Yes

**bakerman** · 07-24-2013, 01:55 PM

If you usev the macro like this, you don't have to worry about adjusting the range for columns G and H.
So you can keep adding words and the correct range will be selected automattically.

Code:

Sub kTest()
    
    Dim MyTable, i As Long
    
    With Worksheets(1)
        MyTable = .Range("G2:I" & .Cells(.Rows.Count, 7).End(xlUp).Row).Value2
        With .UsedRange.Columns(2)
            For i = 1 To UBound(MyTable, 1)
                .Replace MyTable(i, 1), MyTable(i, 2), MyTable(i, 3)
            Next
        End With
    End With
    
End Sub

**william516** · 07-24-2013, 10:56 PM

Ok I attempted to use your code that is listed directly above and I am getting an error subscript out of range. Does the table have to be located on the SAME page as the items that are being changed or can it run from its own page. Currently I have it trying to run from a page that I have called "AUTO CHANGE". The page where the VBA routine should be looking and changing things is on a page called INITIATING DEVICES. I can not have it run on the same page due to the amount of data and rows. All the columns listed in the table above would already be filled up.

Code:

Sub kTest()
    
    Dim MyTable, i As Long
    
    With Worksheets(5)   'worksheet number 5 is the "INITIATING DEVICES" page
        MyTable = .Range("G2:I" & .Cells(.Rows.Count, 7).End(xlUp).Row).Value2
        With .UsedRange.Columns(2)
            For i = 1 To UBound(MyTable, 1)
                .Replace MyTable(i, 1), MyTable(i, 2), MyTable(i, 3)
            Next
        End With
    End With
    
End Sub

Listed above is what I have and the only thing I did was try to change worksheet(1) to worksheet(5) as this is where the "INITIATING DEVICES" page is found. I'm sure im doing something wrong here as it works really good on the file that I was sent. I'm also assuming that Value2 is a reference to Column 2 or (B) and that if I needed it to look other places I could change this for future ref.

Thanks again for all the help

**testingcode** · 07-24-2013, 11:21 PM

**Edit**

I may have been wrong in my original assessment. There are a lot of possible reasons why that code wouldn't work anymore. First one being, you are using two sheets now. Hopefully, bakerman can clear it up for you.