Find and Replace exact string of text

[Serafin54]

Hello,

I have a code that replaces text with a number and it works except when a word is contained in another string. For instance, there is "Hispanic" which is a code 3 but since Hispanic also shows up in the string "Two or more Races(Not Hispanic)" which should be 7, I get "Two or more races (Not 3 or Latino)" or if it was "Hispanic/Latino" I would get "3/Latino".

Is there a way to make the text exact in the Const Ethnicity As String statement so that it looks for the entire string between the commas?

Sub Ethnic_Codes(control As IRibbonControl)
'v2.1
Const Ethnicity As String = _
"White,Black or African American,Hispanic,Asian,American Indian or Alaska Native,Native Hawaiian or Other Pacific Islander," & _
"Two or more races(Not Hispanic or Latino),Hispanic/Latino,Black/African American"


Const EthnicCodes As String = _
"1,2,3,4,5,6,7,3,2"

Dim vecEthnicity As Variant
Dim vecEthnicCodes As Variant
    Dim rStart As Range
    Set rStart = Selection
vecEthnicity = Split(Ethnicity, ",")
vecEthnicCodes = Split(EthnicCodes, ",")


For i = LBound(vecEthnicity) To UBound(vecEthnicity)
    'Set the range to suit
    rStart.Replace vecEthnicity(i), vecEthnicCodes(i)
Next

End Sub

 

[KenU]

Perhaps you simply need to reverse the order of the encoding by changing the FOR loop as follows:

For i = UBound(vecEthnicity) To LBound(vecEthnicity) Step -1

That will replace the longer, more specific strings first and should avoid the problem. Hope that helps.

Regards,
Ken

 

[Serafin54]

Perhaps you simply need to reverse the order of the encoding by changing the FOR loop as follows:

For i = UBound(vecEthnicity) To LBound(vecEthnicity) Step -1

That will replace the longer, more specific strings first and should avoid the problem. Hope that helps.

Regards,
Ken

Doesn't seem to have made any difference unfortunately. This is what i am getting either way i code that line. Before on the left, after the right.

Race Description	Race Description
Black or African American	2
Hispanic	3
White	1
Asian	4
American Indian or Alaska Native	5
Two or more races (Not Hispanic or Latino)	Two or more races (Not 3 or Latino)
Native Hawaiian or Other Pacific Islander	6

 

[Alex Blakenburg]

Since you seem to want an exact match using a dictionary might work for you.

Sub TestReplaceExact()
    'v2.1
    Const Ethnicity As String = _
    "White,Black or African American,Hispanic,Asian,American Indian or Alaska Native,Native Hawaiian or Other Pacific Islander," & _
    "Two or more races(Not Hispanic or Latino),Hispanic/Latino,Black/African American"
   
   
    Const EthnicCodes As String = _
    "1,2,3,4,5,6,7,3,2"
   
    Dim vecEthnicity As Variant
    Dim vecEthnicCodes As Variant
    Dim rStart As Range
    Dim arrStart As Variant
    Dim dictPhrase As Object
    Dim i As Long
   
    Set rStart = Selection
    arrStart = rStart.Value
   
    vecEthnicity = Split(Ethnicity, ",")
    vecEthnicCodes = Split(EthnicCodes, ",")
   
    Set dictPhrase = CreateObject("Scripting.dictionary")
   
    ' Load details range into Dictionary
    For i = 0 To UBound(vecEthnicity)
        If Not dictPhrase.exists(vecEthnicity(i)) Then
            dictPhrase(vecEthnicity(i)) = vecEthnicCodes(i)
        End If
    Next i
   
    For i = 1 To UBound(arrStart)
        If dictPhrase.exists(arrStart(i, 1)) Then
            arrStart(i, 1) = dictPhrase(arrStart(i, 1))
        End If
   
    Next i
   
    rStart = arrStart
End Sub

 

[johnnyL]

Another alternative:

Book3
	A	B
1	Race Description
2	Black or African American
3	Hispanic
4	White
5	Asian
6	American Indian or Alaska Native
7	Two or more races (Not Hispanic or Latino)
8	Native Hawaiian or Other Pacific Islander
9
Sheet1

Sub Ethnic_Codes()
'
'v2.1
'
Const Ethnicity As String = _
"White,Black or African American,Hispanic,Asian,American Indian or Alaska Native,Native Hawaiian or Other Pacific Islander," & _
"Two or more races (Not Hispanic or Latino),Hispanic/Latino,Black/African American"
'
Const EthnicCodes As String = "1,2,3,4,5,6,7,3,2"
'
    Dim vecEthnicity    As Variant
    Dim vecEthnicCodes  As Variant
    Dim cel             As Range
    Dim rStart          As Range
'
    Set rStart = Selection
'
      vecEthnicity = Split(Ethnicity, ",")
    vecEthnicCodes = Split(EthnicCodes, ",")
'
    For Each cel In rStart
        For i = LBound(vecEthnicity) To UBound(vecEthnicity)
            If cel.Value = vecEthnicity(i) Then cel.Value = vecEthnicCodes(i)
        Next
    Next
End Sub

 

[johnnyL]

If you want the results in the next column, the code could be:

Sub Ethnic_Codes()
'
'v2.1
'
Const Ethnicity As String = _
"White,Black or African American,Hispanic,Asian,American Indian or Alaska Native,Native Hawaiian or Other Pacific Islander," & _
"Two or more races (Not Hispanic or Latino),Hispanic/Latino,Black/African American"
'
Const EthnicCodes As String = "1,2,3,4,5,6,7,3,2"
'
    Dim vecEthnicity    As Variant
    Dim vecEthnicCodes  As Variant
    Dim cel             As Range
    Dim rStart          As Range
'
    Set rStart = Selection
'
      vecEthnicity = Split(Ethnicity, ",")
    vecEthnicCodes = Split(EthnicCodes, ",")
'
    For Each cel In rStart
        For i = LBound(vecEthnicity) To UBound(vecEthnicity)
            If cel.Value = vecEthnicity(i) Then cel.Offset(0, 1) = vecEthnicCodes(i)
        Next
    Next
End Sub

 

[bebo021999]

In your original code, just re-arrange the priority order, then it should works:

Const Ethnicity As String = _
"Two or more races (Not Hispanic or Latino),Native Hawaiian or Other Pacific Islander,American Indian or Alaska Native,Black or African American,Black/African American,Hispanic/Latino,Hispanic,White,Asian"
Const EthnicCodes As String = _
"7,6,5,2,2,3,3,1,4"

 

[Serafin54]

Since you seem to want an exact match using a dictionary might work for you.

Sub TestReplaceExact()
    'v2.1
    Const Ethnicity As String = _
    "White,Black or African American,Hispanic,Asian,American Indian or Alaska Native,Native Hawaiian or Other Pacific Islander," & _
    "Two or more races(Not Hispanic or Latino),Hispanic/Latino,Black/African American"
 
 
    Const EthnicCodes As String = _
    "1,2,3,4,5,6,7,3,2"
 
    Dim vecEthnicity As Variant
    Dim vecEthnicCodes As Variant
    Dim rStart As Range
    Dim arrStart As Variant
    Dim dictPhrase As Object
    Dim i As Long
 
    Set rStart = Selection
    arrStart = rStart.Value
 
    vecEthnicity = Split(Ethnicity, ",")
    vecEthnicCodes = Split(EthnicCodes, ",")
 
    Set dictPhrase = CreateObject("Scripting.dictionary")
 
    ' Load details range into Dictionary
    For i = 0 To UBound(vecEthnicity)
        If Not dictPhrase.exists(vecEthnicity(i)) Then
            dictPhrase(vecEthnicity(i)) = vecEthnicCodes(i)
        End If
    Next i
 
    For i = 1 To UBound(arrStart)
        If dictPhrase.exists(arrStart(i, 1)) Then
            arrStart(i, 1) = dictPhrase(arrStart(i, 1))
        End If
 
    Next i
 
    rStart = arrStart
End Sub

Thank you. This works very well. If i needed to add to the code

 

[Serafin54]

Another alternative:

Book3
	A	B
1	Race Description
2	Black or African American
3	Hispanic
4	White
5	Asian
6	American Indian or Alaska Native
7	Two or more races (Not Hispanic or Latino)
8	Native Hawaiian or Other Pacific Islander
9
Sheet1

Sub Ethnic_Codes()
'
'v2.1
'
Const Ethnicity As String = _
"White,Black or African American,Hispanic,Asian,American Indian or Alaska Native,Native Hawaiian or Other Pacific Islander," & _
"Two or more races (Not Hispanic or Latino),Hispanic/Latino,Black/African American"
'
Const EthnicCodes As String = "1,2,3,4,5,6,7,3,2"
'
    Dim vecEthnicity    As Variant
    Dim vecEthnicCodes  As Variant
    Dim cel             As Range
    Dim rStart          As Range
'
    Set rStart = Selection
'
      vecEthnicity = Split(Ethnicity, ",")
    vecEthnicCodes = Split(EthnicCodes, ",")
'
    For Each cel In rStart
        For i = LBound(vecEthnicity) To UBound(vecEthnicity)
            If cel.Value = vecEthnicity(i) Then cel.Value = vecEthnicCodes(i)
        Next
    Next
End Sub

Thank you. This does work but there seems to be bit of a hang when running on a large range. I really appreciate the code though.

 

[Serafin54]

In your original code, just re-arrange the priority order, then it should works:

Const Ethnicity As String = _
"Two or more races (Not Hispanic or Latino),Native Hawaiian or Other Pacific Islander,American Indian or Alaska Native,Black or African American,Black/African American,Hispanic/Latino,Hispanic,White,Asian"
Const EthnicCodes As String = _
"7,6,5,2,2,3,3,1,4"

Thanks. I figured my original code had to do with the order of the names. If I added more ethnicity naming conventions to it, what are things I would need to keep in mind? Like, what trumps what?