VBA: search and replace txt strings with multiple search words

[techgrl]

Hi!

So I have been pulling my hair our trying to figure out how to build a <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym> for a process that is so time consuming and repetitive and deadly.

background: I have hundreds of records of customer info and I am trying to categorize the job titles so that I can conduct some analysis with a pivot table. My problem is that there is about 20 different ways and variations of "manager" so Instead of autofiltering for "mrg." "Manager" "marketing manager" ect. and then replacing the text manually and using the enter and fill process (to create some standardization to compare "manager" to "director" to "c-level" to "consultant", etc.) and repeating this process over and over again...

I would like to create a <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym> that would search the column "job title" for multiple text strings at once and if the text string was true in the cell then the cell would be replaced by a new text string "Manager". I was thinking a series of if functions within one<acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">vba</acronym> but I am not sure if this is possible. I need help with developing the actually code and direction as if this is even possible.

This link is to a piece of my sample data to help with understanding

https://docs.google.com/spreadsheets/d/1-v3u2RgThLVMnkLVWUbdIa_q5YVmg0bFBfE7sTUz0LI/edit?usp=sharing


I am working with a Mac and have excel 2010.

Any help would be very much appreciated!

 

[pbornemeier]

In the BuildReplacementArrayAndReplace sub build an array of arrays of terms to be replaced with each sub-array starting with the word that will do the replacing.

In the MultipleReplace sub modify the lJobTitleColumn to reflect the column number of the Job Title

Test on a copy of your data - this is NOT reversible.

The order of words to be replaced is important. Replacing "mgr" with "Manager" before replacing "marketing mgr" with "Manager" means that "marketing mgr" will not be seen (unless that is an additional item in the array) since it will have been changed to "marketing Manager"

Running this code twice on the same Job Title list will not likely result in a satisfactory outcome.

Option Explicit

Sub BuildReplacementArrayAndReplace()
    'Build an array of arrays
    'Each of the subordinate arrays should be built so the first item in it is the value that will replace
    '  any of the second through last items in it.
    '  aryMultiple(0) = Array("Manager", "mgr.", "mgr", "marketing manager")
    
    Dim aryMultiple() As Variant
    Dim lX As Long
    
    'Build an array of arrays
    ReDim Preserve aryMultiple(0 To 0)
    aryMultiple(0) = Array("Manager", "mgr.", "mgr", "marketing manager", "director")
    
    ReDim Preserve aryMultiple(0 To 1)
    aryMultiple(1) = Array("CIO", "Chief Information Officer", "Chief Technology Officer")
    
    
    'Iterate the array or arrays and call the sub that does the actual replacement
    For lX = LBound(aryMultiple) To UBound(aryMultiple)
        MultipleReplace aryMultiple(lX)
    Next
    
End Sub

Sub MultipleReplace(varySynonyms As Variant)
    'Replace any occurence of the 2-nth value in the array with the first value in the array

    Const lJobTitleColumn As Long = 9  'Set this to the number of your job column (A=1, B=2, etc.)
    
    'Dim varySynonyms As Variant
    Dim lLastJCTRow As Long
    Dim lX As Long
    
    lLastJCTRow = Cells(Rows.Count, lJobTitleColumn).End(xlUp).Row

    'varySynonyms = Array("Manager", "mgr.", "marketing manager")
    For lX = LBound(varySynonyms) + 1 To UBound(varySynonyms)
    
        Range(Cells(2, lJobTitleColumn), Cells(lLastJCTRow, lJobTitleColumn)).Replace _
            What:=varySynonyms(lX), Replacement:=varySynonyms(0), _
            LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
    
    Next

End Sub

 

[techgrl]

Hi Phil,

Thanks that is very helpful, I have a question about this section:

"ReDim Preserve aryMultiple(0 To 0)
aryMultiple(0) = Array("Manager", "mgr.", "mgr", "marketing manager", "director") ReDim Preserve aryMultiple(0 To 1) aryMultiple(1) = Array("CIO", "Chief Information Officer", "Chief Technology Officer")I understand that I would repeat the language "ReDim Preserve artMultiple" but what my next array be (0 To 1) again? Or would it be (1 To 2)? Thanks again!! </pre>

 

[pbornemeier]

Next would be 0 to 2

ReDim Preserve aryMultiple(0 To 2)
aryMultiple(2) = Array("Coder", "Programmer", "Asst Programmer")

ReDim Preserve aryMultiple(0 To 3)
aryMultiple(3) = Array("Sales", "Customer Assistant", "Outside Sales", Inside Sales")

ReDim Preserve aryMultiple(0 To 4)
aryMultiple(4) = Array("ReplacementItem", "ReplacedItem1", "ReplacedItem2", ReplacedItem3")

 

[techgrl]

Hi thanks again phil! this is the code i've created: It would not run because it said I had not declared a variable - do you know where I should do that?/ what it would be? My worksheet is sheet 1 and it is column B the job titles begin in the 2nd row - any more helpful thoughts would be beyond appreciated!

Option Explicit
Sub ARRAY_REPLACE()


'Build an array of arrays
'Each of the subordinate arrays should be built so the first item in it is the value that will replace
' any of the second through last items in it.
' aryMultiple(0) = Array("Manager", "mgr.", "mgr", "marketing manager")

Dim aryMultiple() As Variant
Dim lX As Long

Set RE = CreateObject("VBScript.RegExp"<wbr>)
RE.IgnoreCase = True
RE.Global = True

'Build an array of arrays
ReDim Preserve aryMultiple(0 To 0)
aryMultiple(0) = Array("Manager", "mgmt", "mngr", "management", "managar", "mngmt", "mgr.", "mgr", "marketing manager")

ReDim Preserve aryMultiple(0 To 1)
aryMultiple(1) = Array("C-Level", "CEO", "c.e.o.", "c.e.o", "CFO", "c.f.o.", "c.f.o", "CIO", "c.i.o.", "c.i.o", "CTO", "c.t.o", "c.t.o.", "CSO", "c.s.o", "COO", "C.o.o", "Officer", "Chief", "CIO", "Chief Information Officer", "Chief Technology Officer", "corporate", "partner", "founder", "clevel", "chairman", "principal", "CMO", "CNO", "cofounder", "Co-founder", "CAO", "c.a.o", "CRO", "C.r.o", "president")

ReDim Preserve aryMultiple(0 To 2)
aryMultiple(2) = Array("VP/Executive Level", "Vice President", "vice", "VP", "v.p", "v.p.", "Exec.", "executive", "exec")

ReDim Preserve aryMultiple(0 To 3)
aryMultiple(3) = Array("Director", "Dir.", "head", "Dir", "senior", "senoir", "Sr.", "sr")

ReDim Preserve aryMultiple(0 To 4)
aryMultiple(4) = Array("Engineer", "eng.", "ing.", "ops", "ops.", "Developer", "webmaster", "dev.", "programmer", "technician", "systems", "administrator", "architect")

ReDim Preserve aryMultiple(0 To 5)
aryMultiple(5) = Array("Analyst", "analyst", "specialist", "professional")

ReDim Preserve aryMultiple(0 To 6)
aryMultiple(6) = Array("Consultant", "suport", "solutions", "admin", "associate", "coordinator", "consulting", "intern", "asst.")

ReDim Preserve aryMultiple(0 To 7)
aryMultiple(7) = Array("Non IT/ Random", "attorney", "attny.", "doctor", "nurse", "student", "no job", "sales", "Biz Development", "Communications", "law", "accountant")


'Iterate the array or arrays and call the sub that does the actual replacement
For lX = LBound(aryMultiple) To UBound(aryMultiple)
MultipleReplace aryMultiple(lX)
Next

End Sub


Sub MultipleReplace(varySynonyms As Variant)
'Replace any occurence of the 2-nth value in the array with the first value in the array


Const lJobTitleColumn As Long = 1 'Set this to the number of your job column (A=1, B=2, etc.)

'Dim varySynonyms As Variant
Dim lLastJCTRow As Long
Dim lX As Long

lLastJCTRow = Cells(Rows.Count, lJobTitleColumn).End(xlUp).Row


'varySynonyms = Array("Manager", "mgr.", "marketing manager")
For lX = LBound(varySynonyms) + 1 To UBound(varySynonyms)

Range(Cells(2, lJobTitleColumn), Cells(lLastJCTRow, lJobTitleColumn)).Replace _
What:=varySynonyms(lX), Replacement:=varySynonyms(0), _
LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False

Next




End Sub

Thanks again Phil!

 

[pbornemeier]

The complaint came because of the 3 lines that had RE in them and the fact that I have Option Explicit set in the code (good coding practice). I don't see why the RE lines are included, but to stop the error I added another Dim statement which declared the RE variable.

Option Explicit
Sub ARRAY_REPLACE()

    'Build an array of arrays
    'Each of the subordinate arrays should be built so the first item in it is the value that will replace
    ' any of the second through last items in it.
    ' aryMultiple(0) = Array("Manager", "mgr.", "mgr", "marketing manager")
    
    Dim aryMultiple() As Variant
    Dim lX As Long
    Dim RE As Object
    
    Set RE = CreateObject("VBScript.RegExp")
    RE.IgnoreCase = True
    RE.Global = True
    
    'Build an array of arrays
    ReDim Preserve aryMultiple(0 To 7) 'The last number in this line should match the index value of the last line next group of lines
    
    'Start with an index value of aryMultiple(0) in the first line and increment the value in parenthesis by 1 for each additional line
    aryMultiple(0) = Array("Manager", "mgmt", "mngr", "management", "managar", "mngmt", "mgr.", "mgr", _
        "marketing manager")
    aryMultiple(1) = Array("C-Level", "CEO", "c.e.o.", "c.e.o", "CFO", "c.f.o.", "c.f.o", "CIO", "c.i.o.", _
        "c.i.o", "CTO", "c.t.o", "c.t.o.", "CSO", "c.s.o", "COO", "C.o.o", "Officer", "Chief", "CIO", _
        "Chief Information Officer", "Chief Technology Officer", "corporate", "partner", "founder", _
        "clevel", "chairman", "principal", "CMO", "CNO", "cofounder", "Co-founder", "CAO", "c.a.o", _
        "CRO", "C.r.o", "president")
    aryMultiple(2) = Array("VP/Executive Level", "Vice President", "vice", "VP", "v.p", "v.p.", _
        "Exec.", "executive", "exec")
    aryMultiple(3) = Array("Director", "Dir.", "head", "Dir", "senior", "senoir", "Sr.", "sr")
    aryMultiple(4) = Array("Engineer", "eng.", "ing.", "ops", "ops.", "Developer", "webmaster", "dev.", _
        "programmer", "technician", "systems", "administrator", "architect")
    aryMultiple(5) = Array("Analyst", "analyst", "specialist", "professional")
    aryMultiple(6) = Array("Consultant", "suport", "solutions", "admin", "associate", "coordinator", _
        "consulting", "intern", "asst.")
    aryMultiple(7) = Array("Non IT/ Random", "attorney", "attny.", "doctor", "nurse", "student", _
        "no job", "sales", "Biz Development", "Communications", "law", "accountant")
    
    'Iterate the array of arrays and call the sub that does the actual replacement
    For lX = LBound(aryMultiple) To UBound(aryMultiple)
        MultipleReplace aryMultiple(lX)
    Next

End Sub


Sub MultipleReplace(varySynonyms As Variant)
    'Replace any occurence of the 2-nth value in the array with the first value in the array
    
    Const lJobTitleColumn As Long = 2 'Set this to the number of your job column (A=1, B=2, etc.)
    
    'Dim varySynonyms As Variant
    Dim lLastJCTRow As Long
    Dim lX As Long
    
    lLastJCTRow = Cells(Rows.Count, lJobTitleColumn).End(xlUp).Row
    
    'varySynonyms = Array("Manager", "mgr.", "marketing manager")
    For lX = LBound(varySynonyms) + 1 To UBound(varySynonyms)
    
        Range(Cells(2, lJobTitleColumn), Cells(lLastJCTRow, lJobTitleColumn)).Replace _
            What:=varySynonyms(lX), Replacement:=varySynonyms(0), _
            LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
    
    Next

End Sub

Please use code tags (see link in my sig) when posting large chunks of code. The code will retain its indents and be easier to read.