Decoding a comma delimited cell in excel

[sxschech]

What would be the best way to translate a series of character codes into a description either by a formula or vba. Here are some examples:
[tt]
Cell P2 contains 3, 5, H, ,
Cell P3 contains 1, 2, 3, 4, 5
Cell P4 contains 8, , , ,
[/tt]
These are the definitions:
[tt]
Code Description
1 American Indian or Alaskan Native
2 Asian
3 Black or African American
4 Native Hawaiian or Other Pacific Islander
5 White
8 Prefer Not to Disclose
H Hispanic or Latino
[/tt]
Output Result would be the description and remove extra commas
[tt]
Cell Q2 Black or African American, White, Hispanic or Latino
Cell Q3 American Indian or Alaskan Native, Asian, Black or African American, Native Hawaiian or Other Pacific Islander, White
Cell Q4 Prefer Not to Disclose
[/tt]

 

[Andrzejek]

What have you tried so far....?

Have fun.

---- Andy

 

[mintjulep]

Well, it's kind of a mess, what with numbers as text, and some codes being numbers except for the "H" code being a letter.

The best thing would be to start over so that you could avoid the need to do it.

Is this a one-time thing that you need to do, or will it be ongoing?

 

[Andrzejek]

It is not that difficult: couple For-Next loops, one Split, one Trim, Select Case statement, and it is done.

I just would like to see some effort on sxschech’s side…


Have fun.

---- Andy

 

[sxschech]

Thanks for your suggestion Andy. Was handed some other stuff to work on, so as soon as I can get back to it, I'll let you know whether I came up with something useable. I figured that code would be involved, but wondered whether some formula in another cell might have done the trick.

 

[sxschech]

Solved it. I think what was holding me back was thinking I had to do multiple if statements and look at positions. Then a few minutes ago, I remembered that Find and Replace can take care of this regardless of position. I recorded a macro to do the replacing. After that found some code to remove the extra commas.

Here is what I got.

Sub RaceReplace()
'
' RaceReplace Macro
'
' Keyboard Shortcut: Ctrl+e
'

    Cells.Replace What:="H", Replacement:="Hispanic or Latino", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="1", Replacement:="American Indian or Alaskan Native", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
        False, ReplaceFormat:=False
    Cells.Replace What:="2", Replacement:="Asian", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="3", Replacement:="Black or African American", LookAt _
        :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="4", Replacement:= _
        "Native Hawaiian or Other Pacific Islander", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="5", Replacement:="White", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="8", Replacement:="Prefer Not to Disclose", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Call RemoveComma
End Sub

Sub RemoveComma()
'[URL unfurl="true"]http://www.thecodecage.com/forumz/microsoft-excel-forum/209034-remove-trailing-leading-commas.html[/URL]
    Dim aCell As Range, CellText As String
    For Each aCell In Selection
        CellText = aCell.Value
        Do While CellText Like ",*"
            CellText = Trim(Mid(CellText, 2))
        Loop
        Do While CellText Like "*,"
            CellText = Trim(Left(CellText, Len(CellText) - 1))
        Loop
        aCell.Value = CellText
    Next
End Sub

 

[Andrzejek]

Nice.

Here is what I came up with:

Option Explicit

Sub RaceReplace()
Dim ary() As String
Dim str As String
Dim strOut As String
Dim i As Integer
Dim r As Integer

For r = 2 To 4
    strOut = ""
    ary = Split(Range("P" & r).Value, ",")
    For i = LBound(ary) To UBound(ary)
        If Trim(ary(i)) <> "" Then
            Select Case Trim(ary(i))
                Case "1"
                    str = "American Indian or Alaskan Native"
                Case "2"
                    str = "Asian"
                Case "3"
                    str = "Black or African American"
                Case "4"
                    str = "Native Hawaiian or Other Pacific Islander"
                Case "5"
                    str = "White"
                Case "8"
                    str = "Prefer Not to Disclose'"
                Case "H"
                    str = "Hispanic Or Latino"
            End Select
           If Len(strOut) = 0 Then
                strOut = str
            Else
                strOut = strOut & ", " & str
            End If
        End If
    Next i
    Range("Q" & r).Value = strOut
Next r

End Sub

That deals with only 3 rows:
[tt]
For r = 2 To 4
[/tt]
but it is simple to adjust it to do more rows.



Have fun.

---- Andy

 

[Andrzejek]

Just in case, I would also throw Case Else:

Case Else
    MsgBox(Trim(ary(i)) & " Not Recognized.")

Have fun.

---- Andy