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

[joshbjames]

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!

 

[nigelandrewfoster]

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

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

 

[sandy666]

maybe PowerQuery (Get&Transform)

List		List	New		New
1234,5678		1234​	abcd		abcd,efgh
90,123,4567		5678​	efgh		ij,defg
		90​	ij
		123​
		4567​	defg

[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

 

[joshbjames]

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.

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

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

 

[Rick Rothstein]

Does this macro work for you...

[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]

 

[joshbjames]

This seemed to work perfectly! Thank you so much!

Does this macro work for you...

[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]