VBA: Find and replace an "array" of words

[FryGirl]

I found this macro which works fine for one word, but not sure how not modify for changing an array of words.

Right now the one word within the string I'm looking for is "DET:", but I'd like to add many others.

Could somebody help me with the next step?

Sub ReplaceStr()
    Dim OriVal As String, RepWhat As String, RepWith As String, TempStr As String
    Dim Cell As Range, Rng As Range
    Dim RepLen As Integer
   
    Application.ScreenUpdating = False
    Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    
    RepWhat = "DET:"
    RepWith = "Det:"
    RepLen = Len(RepWhat)

        For Each Cell In Rng
            OriVal = Cell.Value

            Do Until InStr(OriVal, RepWhat) = 0
                TempStr = TempStr & Left(OriVal, InStr(OriVal, RepWhat) - 1) & RepWith
                OriVal = Right(OriVal, Len(OriVal) - ((InStr(OriVal, RepWhat) - 1) + RepLen))
            Loop

            Cell.Value = TempStr & OriVal

            TempStr = ""
            OriVal = ""

        Next Cell
    
    Application.ScreenUpdating = True

End Sub

 

[hiker95]

FryGirl,

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?


Can you display your search words, and, their replacements (something like this):

"DET:", "Det:"

 

[hiker95]

FryGirl,

We could probably create a macro that does not loop thru your rows.

Can we see what your raw data looks like.

In a separate worksheet you could list in column A the search word, and, in column B the replacement word.


To start off, and, so that we can get it right on the first try:

Can you post a screenshot of the actual raw data worksheet?

And, can you post a screenshot of the worksheet results (manually formatted by you) that you are looking for?

To post a small screen shot (NOT a graphic, or, picture) try one of the following:

Excel Jeanie
Download

MrExcel HTML Maker
https://onedrive.live.com/?cid=8cffdec0ce27e813&sc=documents&id=8CFFDEC0CE27E813!189

Borders-Copy-Paste
http://www.mrexcel.com/forum/about-board/444901-how-create-table-like-aladin.html#post2198045

To test the above:
Test Here


Or, you can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.

 

[FryGirl]

Hi Hiker95,

I'm using 2007 and a PC.

Not sure exactly what you mean about displaying the search words. Do you mean can I list them here?

I'm at work and I can't get to any of those HTML posting methods. The clamps are tight here.

 

[hiker95]

FryGirl,

Can you display all your search words, and, their replacements (something like this):

"DET:", "Det:"

And, it would really help if we could see some of the strings that would contain all of the search words>

 

[FryGirl]

Hi Hiker95,

Sorry for the delay...work...gets in the way of the fun stuff.

Anyway, found a way to get some HTML posted...

And here are some samples of the words. First column, "what it is now" and second column, "what I would like"

Data Range
[Table="class: grid"][tr][td] [/td][td]

E​

[/td][td]

F​

[/td][/tr]
[tr][td]

2​

[/td][td]

Aetc​

[/td][td]

AETC​

[/td][/tr]

[tr][td]

3​

[/td][td]

Af​

[/td][td]

AF​

[/td][/tr]

[tr][td]

4​

[/td][td]

Occ​

[/td][td]

OCC​

[/td][/tr]

[tr][td]

5​

[/td][td]

And​

[/td][td]

and​

[/td][/tr]

[tr][td]

6​

[/td][td]

Of​

[/td][td]

of​

[/td][/tr]

[tr][td]

7​

[/td][td]

DET​

[/td][td]

Det​

[/td][/tr]

[tr][td]

8​

[/td][td]

Afelm​

[/td][td]

AFELM​

[/td][/tr]

[tr][td]

9​

[/td][td]

Nav​

[/td][td]

NAV​

[/td][/tr]

[tr][td]

10​

[/td][td]

Nco​

[/td][td]

NCO​

[/td][/tr]

[tr][td]

11​

[/td][td]

Rotc​

[/td][td]

ROTC​

[/td][/tr]

[tr][td]

12​

[/td][td]

Nw​

[/td][td]

NW​

[/td][/tr]

[tr][td]

13​

[/td][td]

Hq​

[/td][td]

HQ​

[/td][/tr]
[/table]


And here are some samples of the strings. First column, "what it is now" and second column, "what I would like"

Data Range
[Table="class: grid"][tr][td] [/td][td]

A​

[/td][td]

B​

[/td][/tr]
[tr][td]

1​

[/td][td]

Description​

[/td][td]

​

[/td][/tr]

[tr][td]

2​

[/td][td]

Aetc Civ Engineer Flight​

[/td][td]

AETC Civ Engineer Flight​

[/td][/tr]

[tr][td]

3​

[/td][td]

Af Occ Measurement Squadron​

[/td][td]

AF OCC Measurement Squadron​

[/td][/tr]

[tr][td]

4​

[/td][td]

Aetc Program Mgmt Flight​

[/td][td]

AETC Program Mgmt Flight​

[/td][/tr]

[tr][td]

5​

[/td][td]

Air Educ And Trng Command OL:A5A8​

[/td][td]

Air Educ And Trng Command OL:A5A9​

[/td][/tr]

[tr][td]

6​

[/td][td]

Air Educ And Trng Command OL:000D​

[/td][td]

Air Educ And Trng Command OL:000D​

[/td][/tr]

[tr][td]

7​

[/td][td]

Aetc Studies & Ana Squadron​

[/td][td]

AETC Studies & Ana Squadron​

[/td][/tr]

[tr][td]

8​

[/td][td]

Aetc Computer Sys Squadron​

[/td][td]

AETC Computer Sys Squadron​

[/td][/tr]

[tr][td]

9​

[/td][td]

Af Inst Of Tech Institute​

[/td][td]

AF Inst Of Tech Institute​

[/td][/tr]

[tr][td]

10​

[/td][td]

Af Inst Of Tech Institute DET:0001​

[/td][td]

AF Inst Of Tech Institute Det:0002​

[/td][/tr]

[tr][td]

11​

[/td][td]

Af Research Institute​

[/td][td]

AF Research Institute​

[/td][/tr]

[tr][td]

12​

[/td][td]

Air University University DET:0001​

[/td][td]

Air University University Det:0002​

[/td][/tr]

[tr][td]

13​

[/td][td]

Afelm Nav Postgrad Element​

[/td][td]

AFELM NAV Postgrad Element​

[/td][/tr]

[tr][td]

14​

[/td][td]

Commun Col Af College​

[/td][td]

Commun Col AF College​

[/td][/tr]

[tr][td]

15​

[/td][td]

Senior Nco Academy School​

[/td][td]

Senior NCO Academy School​

[/td][/tr]

[tr][td]

16​

[/td][td]

Air Force Rotc Corps​

[/td][td]

Air Force ROTC Corps​

[/td][/tr]

[tr][td]

17​

[/td][td]

Afrotc Northeast Region OL:NE00​

[/td][td]

AFROTC Northeast Region OL:NE01​

[/td][/tr]

[tr][td]

18​

[/td][td]

Afrotc Nw Region OL:NW00​

[/td][td]

AFROTC NW Region OL:NW01​

[/td][/tr]

[tr][td]

19​

[/td][td]

Hq Af Recruiting Service OL:000A​

[/td][td]

HQ AF Recruiting Service OL:000A​

[/td][/tr]
[/table]

If at all possible, just like the code posted above, can these updates be done in column A? If it requires a helper column that would be fine as the helper column could just be pasted on top of column A.

 

[hiker95]

FryGirl,

Here is a macro solution for you to consider.

For the macro to work correctly you should swap the Of of , to of Of - see the Yellow cells.

Sample raw data in worksheet Data:

Excel 2007
	A	B	C	D	E	F
1	Description				Search	Replace
2	Aetc Civ Engineer Flight				Aetc	AETC
3	Af Occ Measurement Squadron				Af	AF
4	Aetc Program Mgmt Flight				Occ	OCC
5	Air Educ And Trng Command OL:A5A8				And	and
6	Air Educ And Trng Command OL:000D				of	Of
7	Aetc Studies & Ana Squadron				DET	Det
8	Aetc Computer Sys Squadron				Afelm	AFELM
9	Af Inst Of Tech Institute				Nav	NAV
10	Af Inst Of Tech Institute DET:0001				Nco	NCO
11	Af Research Institute				Rotc	ROTC
12	Air University University DET:0001				Nw	NW
13	Afelm Nav Postgrad Element				Hq	HQ
14	Commun Col Af College
15	Senior Nco Academy School
16	Air Force Rotc Corps
17	Afrotc Northeast Region OL:NE00
18	Afrotc Nw Region OL:NW00
19	Hq Af Recruiting Service OL:000A
20
Data

After the macro:

Excel 2007
	A	B	C	D	E	F
1	Description				Search	Replace
2	AETC Civ Engineer Flight				Aetc	AETC
3	AF OCC Measurement Squadron				Af	AF
4	AETC Program Mgmt Flight				Occ	OCC
5	Air Educ and Trng Command OL:A5A8				And	and
6	Air Educ and Trng Command OL:000D				of	Of
7	AETC Studies & Ana Squadron				DET	Det
8	AETC Computer Sys Squadron				Afelm	AFELM
9	AF Inst Of Tech Institute				Nav	NAV
10	AF Inst Of Tech Institute Det:0001				Nco	NCO
11	AF Research Institute				Rotc	ROTC
12	Air University University Det:0001				Nw	NW
13	AFELM NAV Postgrad Element				Hq	HQ
14	Commun Col AF College
15	Senior NCO Academy School
16	Air Force ROTC Corps
17	AFROTC Northeast Region OL:NE00
18	AFROTC NW Region OL:NW00
19	HQ AF Recruiting Service OL:000A
20
Data

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Compare Text
Sub FindReplace()
' hiker95, 02/24/2015, ME838239
Dim sr, i As Long
Dim c As Range
Application.ScreenUpdating = False
With Sheets("Data")
  sr = .Range("E2:F" & .Cells(Rows.Count, "E").End(xlUp).Row)
  For Each c In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
    For i = LBound(sr) To UBound(sr)
      If InStr(c, sr(i, 1)) Then
        c = Replace(c, sr(i, 1), sr(i, 2))
      End If
    Next i
  Next c
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the FindReplace macro.

 

[FryGirl]

Thanks hiker95

I'll test this tmw at work and then provide feedback. Thank you very much for your time.

I noticed "Dim sr". Does that mean it is dimmed as a variant?

 

[hiker95]

FryGirl,

Thanks hiker95

I'll test this tmw at work and then provide feedback. Thank you very much for your time.

You are very welcome.

Will check tomorrow for your next reply.

I noticed "Dim sr". Does that mean it is dimmed as a variant?

Yes, I read range E2:F13 into the array, and, use it to search, and, replace.

I loop thru the array for each cell in column A.

 

[FryGirl]

Good Morning Hiker95,

All is testing out great so far. One tweak so far. I asked for Af to be AF, but forgot to include Aircraft which turned out as AircrAFt. To fix, just added a space after the search and replace for Af/AF and all worked.

Since this is part of a bigger macro, it may work best to write the search/replace values onto the spreadsheet as an array.

I tried

  .Range("E2:E18").Value = Array("Aetc", "Af ", "Occ", "And", "of", "DET", "Afelm", "Nav", "Nco", "Rotc", "Nw", "Hq", "Def", "Usaf", "Afrotc", "Dod", "Dli")
  .Range("F2:F18").Value = Array("AETC", "AF ", "OCC", "and", "Of", "Det", "AFELM", "NAV", "NCO", "ROTC", "NW", "HQ", "DEF", "USAF", "AFROTC", "DoD", "DLI")

but this does not like spreading out vertically, but of course if I change to something like .Range("E1:U1") the array reads in correctly.

Can this be done? Reading the array onto the spreadsheet horizontally?