Replace codes with names adding chr(10)

[288enzo]

Hi all,

I'm working on a macro that can convert something like

4A4, 9VL, Q2J, QJ4, 4D3, PV3

into -

Heated Seats (Rear) BOSE® Surround Sound System Ventilated Seats (Front) Power Seats (14-way) with Comfort Memory Adaptive Cruise Control incl. Lane Keep Assist (LKA) HD-Matrix Design LED Headlights

What I began with was a simple loop:

    For a = 2 To LastRow
    
    b = "AG"
    
        If Range(b & a) = "4A4" Then Range(b & a) = "Heated Seats (Rear)"
        If Range(b & a) = "9VL" Then Range(b & a) = "BOSE® Surround Sound System"
        If Range(b & a) = "Q2J" Then Range(b & a) = "Ventilated Seats (Front)"
        If Range(b & a) = "QJ4" Then Range(b & a) = "Power Seats (14-way) with Comfort Memory"
        If Range(b & a) = "4D3" Then Range(b & a) = "Adaptive Cruise Control incl. Lane Keep Assist (LKA)"
        If Range(b & a) = "PV3" Then Range(b & a) = "HD-Matrix Design LED Headlights"
    Next a

I utilized the next column (AH) over adding the formula

=SUBSTITUTE(AG2,", ",CHAR(10))

copied that down and formatted AH to wrap.

My issue I foresee is one of the codes being a match as part of a word and throwing a wrench into it. As an example, if there is a code "ATE" that equals "Heated Seats (Front)" and is ran after "Heated Seats (Rear)", then I would get "HeHeated Seats (Front)d Seats (Rear)".

I had thought to look specifically for "ATE, " in the above example, that would solve my dilemma, however the last code would always create confusion as there isn't the helping qualifier of ", ".

Thank you

 

[Scott Huish]

I would split it on the commas and replace them something like this:

Sub switchcodes()
Dim c As Range, t, u As Long
For Each c In Range("AG2:AG2" & Range("AG" & Rows.Count).End(xlUp).Row)
t = Split(c, ",")
For u = 0 To UBound(t)
    t(u) = CodeSwitch(t(u))
Next
c = Join(t, Chr(10))
Next

End Sub


Private Function CodeSwitch(r)
r = Trim(r)
Select Case r
    Case "4A4": CodeSwitch = "Heated Seats (Rear)"
    Case "9VL": CodeSwitch = "BOSE® Surround Sound System"
    Case "Q2J": CodeSwitch = "Ventilated Seats (Front)"
    Case "QJ4": CodeSwitch = "Power Seats (14-way) with Comfort Memory"
    Case "4D3": CodeSwitch = "Adaptive Cruise Control incl. Lane Keep Assist (LKA)"
    Case "PV3": CodeSwitch = "HD-Matrix Design LED Headlights"
    Case Else: CodeSwitch = r
End Select
End Function

 

[jolivanes]

Cell A1 on down has the abbreviated values.
Cell B1 on down has equivalent long values
Cell F1 on down has abbreviated values that need to be changed to long values.
Change all references where required.

Sub Or_So()
Dim shArr, explArr, c As Range
shArr = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
explArr = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
    For Each c In Range("F1:F" & Cells(Rows.Count, 6).End(xlUp).Row)
        c.Value = explArr(Application.Match(c.Value, shArr, False), 1)
    Next c
End Sub

The Column A and B values could be on a hidden sheet that can be added to or changed as required.
The loop can be eliminated if it is a large range that need changing to speed things up.

 

[jolivanes]

If needed in a single cell separated by Char(10).
extend both codeArr & replArr as required.
Each item in replArr corresponds to same positioned item in codeArr.
Both codeArr & replArr can be arrived at same as in Post #3 to minimize possible typing errors.
Result will be in Range("G1"). Need Column G to be wide enough.

Sub With_Char_Ten()
Dim codeArr, replArr, dataArr, combi, i As Long
codeArr = Array("4A4", "9VL", "Q2J", "QJ4", "4D3", "PV3")
replArr = Array("Heated Seats (Rear)", "BOSE® Surround Sound System", "Ventilated Seats (Front)", _
"Power Seats (14-way) with Comfort Memory", "Adaptive Cruise Control incl Lane Keep Assist (LKA)", "HD-Matrix Design LED Headlights")
dataArr = Range("F1:F" & Cells(Rows.Count, 6).End(xlUp).Row).Value
combi = ""
    For i = LBound(dataArr) To UBound(dataArr)
        combi = combi & Chr(10) & replArr(Application.Match(dataArr(i, 1), codeArr, False) - 1)
    Next i
Range("G1").Value = Mid(combi, 2)
End Sub

 

[Fuji]

Utilze Replace method.

Sub test()
    Dim e
    With Range("ag2").Resize(Cells.SpecialCells(11).Row)
        For Each e In Array(Array("4A4", "Heated Seats (Rear)"), _
                                    Array("9VL", "BOSE" & [unichar(174)] & " Surround system"), _
                                    Array("Q2J", "Ventilated Seats (Front)"), _
                                    Array("QJ4", "Ventilated Seats (Front)"), _
                                    Array("QJ4", "Power Seats (14-way) with Comfort Memory"), _
                                    Array("4D3", "Adaptive Cruise Control incl. Lane Keep Assist (LKA)"), _
                                    Array("PV3", "HD-Matrix Design LED Headlights"))
            .Replace e(0), e(1), 2
        Next
        .Replace ", ", vbLf, 2
        .WrapText = True
    End With
End Sub

Better to have a list somewhere on the sheet to make it easier.
If you have sheet named "List" from A1 and it has a list in Col. A & B.
A = Find string and B = Replace string

Sub test2()
    Dim r As Range
    With Range("ag2").Resize(Cells.SpecialCells(11).Row)
        For Each r In Sheets("list").[a1].CurrentRegion.Columns(1).Cells
            .Replace r, r(, 2), 2
        Next
        .Replace ", ", vbLf, 2
        .WrapText = True
    End With
End Sub