Find and Replace with multiple values for each occurrence (VBA)

Question

I have SKUs that must be converted multiple times dependent on the number of pieces. For example original data:

brp-100_cn_3pc_16x20

desired outcome:

brp-100a_cn_16x20
brp-100b_cn_16x20
brp-100c_cn_16x20

each in a separate cell in same column (notice 3pc = a,b,c for other SKUs 4pc = a,b,c,d…etc) The data is being copied from a pivot table and pasted to another sheet. I recorded a Macro and added a For Each statement. It works for only the first instance not all the pasted SKUs.

Thanks in advance

Sub ReplaceEach()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual

Dim myrange As range
Set myrange = Sheets("PT_Data").range("K" & Rows.count).End(xlUp)
Dim i As Variant

Columns("K:K").Select

For Each i In myrange

Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="a_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="b_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="c_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="d_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="e_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="f_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="g_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="h_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="i_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Next i

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic

End Sub

You want to avoid using `Activate`, the active cell is not always the one you think it is. Have a look at [this](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — cybernetic.nomad, Nov 15 '18 at 16:51

Tim Williams · Accepted Answer · 2018-11-16T15:38:24.787

You can use something like this:

Sub ExpandAll()
    Dim c As Range, arr
    'loop over the input values
    For Each c In ActiveSheet.Range("B3:B8").Cells
        arr = ExpandSKU(c.Value) '<< expand this SKU
        'adjust destination to suit...
        ActiveSheet.Cells(Rows.Count, 4).End(xlUp). _
              Offset(1, 0).Resize(UBound(arr, 1), 1).Value = arr
        c.Value = "" 'clear the original
    Next c
End Sub



Function ExpandSKU(sku)
    Dim arrSku, arrOut(), num, i As Long
    arrSku = Split(sku, "_")

    num = Replace(arrSku(2), "pc", "")
    ReDim arrOut(1 To num, 1 To 1)
    For i = 1 To num
        arrOut(i, 1) = Join(Array(arrSku(0) & Chr(96 + i), _
                                  arrSku(1), arrSku(3)), "_")
    Next i

    ExpandSKU = arrOut
End Function

Works great! But i also need the original SKU cleared/deleted from the column. Can't figure it out. I have never worked with Functions before. Thanks — A Rossi, Nov 16 '18 at 14:33

Find and Replace with multiple values for each occurrence (VBA)

1 Answers1