Find and replace values within a comma delimited string and omit/flag no matches

J

joshbjames

New Member
Joined
Jul 25, 2017
Messages
33
We are redoing the category structure of our website. Some products live in multiple categories, so the field will contain 2 or more category IDs like 1234,5678 or 90,123,4567. I have a lookup table of what the new values should be, but some of the categories are also going away.

Sample Data

Sheet 1 colA (column A is a list of comma delimited strings)
1234,5678
90,123,4567

Sheet 2 colA, colB (Column A is the current value. Column B is the new value.)
1234, abcd
5678, efgh
90, ij
123,
4567, defg

In this example, how could find and replace the values on sheet 1 with the values on the lookup table of sheet 2 while also omitting (or at least flagging) the ones with no update?

1234,5678 becomes abcd,efgh (both values are presant)
90,123,4567 becomes ij,defg OR ij,Error,defg (123 does not have a new category)

Thank you in advance!
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
Not the most elegant code, but it works with your tiny example.

Code: 
Sub Find_Replace()    Dim rngInitColumn As Range
    Dim rngReplaceColumn As Range
    Dim rngReplacement As Range
    Dim cel As Range
    Dim astrCellValues() As String
    Dim strTemp As String
    Dim intCommaPos As Integer
    Dim intValuesCount As Integer
    Dim intValue As Integer
    Dim intReplace As Integer
    Dim blnCellChanged As Boolean
    
    With Worksheets("Sheet1")
        Set rngInitColumn = .Range(.[a1], .[a1048576].End(xlUp))
    End With
    
    With Worksheets("Sheet2")
        Set rngReplaceColumn = .Range(.[a1], .[a1048576].End(xlUp))
    End With
    
    For Each cel In rngInitColumn
        If cel.Value <> "" Then
            strTemp = cel.Value
            intValuesCount = Len(Trim(strTemp)) - Len(Replace(Trim(strTemp), ",", "")) + 1
            ReDim astrCellValues(intValuesCount)
            If intValuesCount = 1 Then
                astrCellValues(1) = strTemp
            Else
                For intValue = 1 To intValuesCount
                    intCommaPos = InStr(1, strTemp, ",")
                    If intCommaPos > 0 Then
                        astrCellValues(intValue) = Left(strTemp, intCommaPos - 1)
                    Else
                        astrCellValues(intValue) = strTemp
                    End If
                    strTemp = Right(strTemp, Len(strTemp) - intCommaPos)
                Next
                For intReplace = 1 To intValuesCount
                    Set rngReplacement = rngReplaceColumn.Find(What:=astrCellValues(intReplace), LookIn:=xlValues, LookAt:=xlWhole)
                    If Not rngReplacement Is Nothing Then
                        If rngReplacement.Offset(, 1).Value = "" Then astrCellValues(intReplace) = astrCellValues(intReplace) & ","
                        cel.Value = Replace(cel.Value, astrCellValues(intReplace), rngReplacement.Offset(, 1).Value)
                        Set rngReplacement = Nothing
                    End If
                Next
            End If
        End If
    Next
End Sub
 
Upvote 0
maybe PowerQuery (Get&Transform)

[Table="width:, class:head"]
[tr=bgcolor:#FFFFFF][td=bgcolor:#5B9BD5]List[/td][td][/td][td=bgcolor:#5B9BD5]List[/td][td=bgcolor:#5B9BD5]New[/td][td][/td][td=bgcolor:#70AD47]New[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#DDEBF7]1234,5678[/td][td][/td][td=bgcolor:#DDEBF7]
1234​
[/td][td=bgcolor:#DDEBF7]abcd[/td][td][/td][td=bgcolor:#E2EFDA]abcd,efgh[/td][/tr]

[tr=bgcolor:#FFFFFF][td]90,123,4567[/td][td][/td][td]
5678​
[/td][td]efgh[/td][td][/td][td]ij,defg[/td][/tr]

[tr=bgcolor:#FFFFFF][td][/td][td][/td][td=bgcolor:#DDEBF7]
90​
[/td][td=bgcolor:#DDEBF7]ij[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td][/td][td][/td][td]
123​
[/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td][/td][td][/td][td=bgcolor:#DDEBF7]
4567​
[/td][td=bgcolor:#DDEBF7]defg[/td][td][/td][td][/td][/tr]
[/table]
Code: 
[SIZE=1]let
    Source = Table.NestedJoin(Table1,{"List"},Table2,{"List"},"Table2",JoinKind.LeftOuter),
    #"Expanded Table2" = Table.ExpandTableColumn(Source, "Table2", {"New"}, {"New"}),
    #"Grouped Rows" = Table.Group(#"Expanded Table2", {"Index"}, {{"Count", each _, type table}}),
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "List", each Table.Column([Count],"List")),
    #"Added Custom1" = Table.AddColumn(#"Added Custom", "New", each Table.Column([Count],"New")),
    #"Extracted Values" = Table.TransformColumns(#"Added Custom1", {"List", each Text.Combine(List.Transform(_, Text.From), ","), type text}),
    #"Extracted Values1" = Table.TransformColumns(#"Extracted Values", {"New", each Text.Combine(List.Transform(_, Text.From), ","), type text}),
    #"Removed Other Columns" = Table.SelectColumns(#"Extracted Values1",{"New"})
in
    #"Removed Other Columns"[/SIZE]
example file
 
Upvote 0
I'm not great at VBA so maybe you can help me figure out what I am doing wrong. I press ALT+F11 and insert a new module. Paste your code in. Save as a macro enabled sheet. And then run the module. But I keep getting an error.

nigelandrewfoster said:
Not the most elegant code, but it works with your tiny example.

Code: 
Sub Find_Replace()    Dim rngInitColumn As Range
    Dim rngReplaceColumn As Range
    Dim rngReplacement As Range
    Dim cel As Range
    Dim astrCellValues() As String
    Dim strTemp As String
    Dim intCommaPos As Integer
    Dim intValuesCount As Integer
    Dim intValue As Integer
    Dim intReplace As Integer
    Dim blnCellChanged As Boolean
    
    With Worksheets("Sheet1")
        Set rngInitColumn = .Range(.[a1], .[a1048576].End(xlUp))
    End With
    
    With Worksheets("Sheet2")
        Set rngReplaceColumn = .Range(.[a1], .[a1048576].End(xlUp))
    End With
    
    For Each cel In rngInitColumn
        If cel.Value <> "" Then
            strTemp = cel.Value
            intValuesCount = Len(Trim(strTemp)) - Len(Replace(Trim(strTemp), ",", "")) + 1
            ReDim astrCellValues(intValuesCount)
            If intValuesCount = 1 Then
                astrCellValues(1) = strTemp
            Else
                For intValue = 1 To intValuesCount
                    intCommaPos = InStr(1, strTemp, ",")
                    If intCommaPos > 0 Then
                        astrCellValues(intValue) = Left(strTemp, intCommaPos - 1)
                    Else
                        astrCellValues(intValue) = strTemp
                    End If
                    strTemp = Right(strTemp, Len(strTemp) - intCommaPos)
                Next
                For intReplace = 1 To intValuesCount
                    Set rngReplacement = rngReplaceColumn.Find(What:=astrCellValues(intReplace), LookIn:=xlValues, LookAt:=xlWhole)
                    If Not rngReplacement Is Nothing Then
                        If rngReplacement.Offset(, 1).Value = "" Then astrCellValues(intReplace) = astrCellValues(intReplace) & ","
                        cel.Value = Replace(cel.Value, astrCellValues(intReplace), rngReplacement.Offset(, 1).Value)
                        Set rngReplacement = Nothing
                    End If
                Next
            End If
        End If
    Next
End Sub
Click to expand...
 
Upvote 0
Does this macro work for you...
Code: 
[table="width: 500"]
[tr]
	[td]Sub UpdateCategoryStructure()
  Dim X As Long, NewCats As Variant
  NewCats = Sheets("Sheet2").Range("A1", Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
  With Sheets("Sheet1").Range("A1", Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp))
    .NumberFormat = "@"
    .Value = Evaluate(""",""&'" & .Parent.Name & "'!" & .Address & "&"",""")
    For X = 1 To UBound(NewCats)
      If NewCats(X, 2) = "" Then NewCats(X, 2) = "Error"
      .Replace "," & NewCats(X, 1) & ",", "," & NewCats(X, 2) & ",", xlPart, , , , False, False
    Next
    .Value = Evaluate("IF({1},MID(" & .Address & ",2,LEN(" & .Address & ")-2))")
  End With
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
This seemed to work perfectly! Thank you so much!

Rick Rothstein said:
Does this macro work for you...
Code: 
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub UpdateCategoryStructure()
  Dim X As Long, NewCats As Variant
  NewCats = Sheets("Sheet2").Range("A1", Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
  With Sheets("Sheet1").Range("A1", Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp))
    .NumberFormat = "@"
    .Value = Evaluate(""",""&'" & .Parent.Name & "'!" & .Address & "&"",""")
    For X = 1 To UBound(NewCats)
      If NewCats(X, 2) = "" Then NewCats(X, 2) = "Error"
      .Replace "," & NewCats(X, 1) & ",", "," & NewCats(X, 2) & ",", xlPart, , , , False, False
    Next
    .Value = Evaluate("IF({1},MID(" & .Address & ",2,LEN(" & .Address & ")-2))")
  End With
End Sub[/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Locked
  • Question Question
Sum the values across multiple sheets by category
Replies
1
Views
684
Fluff
Fluff
S
  • Question Question
Find and Replace with lookup table with mutiple conditions (Categories)
Replies
1
Views
515
oldbrewer
O
O
  • Question Question
Find and Replace - quantum of replaces
Replies
0
Views
590
od33n
O

Forum statistics

Threads
1,224,828
Messages
6,181,201
Members
453,022
Latest member
RobertV1609

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top