Search code examples
excelvbacsvexport-to-csv

Ability to tag colored text from Excel file for CSV export?


So a client has a bunch of data stored in Excel sheets that we want to bring into a database, and one component of the data is that it is color-coded. In this case there are model numbers for various equipment with the brand having been recorded by coloring the text. (Different colors represent different brands. The color code number used is always consistent with a certain brand.) Here's an example of a given cell:

color coded example

[Each cell could contain one model, multiple models separated by commas, or nothing.]

If I just export the above as CSV, I'll get:

...,"4100, 4500, 4600",...

Which as you'd expect, discards all the color information.

Can you think of any way to run an Excel Macro or such that would add this color data as textual tags in the cells - so that the color "data" is being "tagged" in the cell instead? Such as something like this:

cell image

Because I'd like to end up with something like this in the CSV export:

...,"<typeG>4100</typeG>, <typeR>4500</typeR>, <typeB>4600</typeB>",...

Or even just something like:

...,"[green]4100, [red]4500, [blue]4600",...

The exact formatting style in the CSV isn't crucial, as I can post-process this later.

Reason for this is I need to be able to export these Excel files to CSV, and then import them into a database (using customized import code). (Each model record will then be getting its own data record, with the brand being relationally specified as an ID. Just for context to understand the why.) The later part I can figure out, I just need to be able to figure out how to automatically tag the models somehow by their color in a CSV.


Solution

  • I finally figured this out. I needed to split the models to an array, determine the character position in the cell of the items in the array, check the Font.Color of those characters, and then adjust the array items with their appropriate tag, and then put the updated array contents back into the cell.

    Here's the code:

    Sub TagModelsWithBrand()
      On Error GoTo ErrHandler:
    
    ' Set your range to process
    Set modelRange = Worksheets("Sheet1").range("B2:M18") 
    
    ' Brands and Color for each
    Const b_1 = "[green]"
    Const b_1c = 32768
    Const b_2 = "[red]"
    Const b_2c = 255
    Const b_3 = "[blue]"
    Const b_3c = 16711680
    Const b_99 = "[Unknown]"
    
    Dim rangeCell As range
    Dim charPosition As Integer
    Dim modelArray() As String
    Dim charColor As Variant
    Dim brand As Integer
    charPosition = 0
    
    For Each rangeCell In modelRange
        If Len(rangeCell.Text > 0) Then
            modelArray = Split(rangeCell.Text, ",")
                For m = 0 To UBound(modelArray)
                    For i = charPosition + 2 To charPosition + Len(modelArray(m))
                        charColor = rangeCell.Characters(i, 1).Font.Color
                        charPosition = charPosition + 1
                            If charColor = b_1c Then
                            brand = 1
                            ElseIf charColor = b_2c Then
                            brand = 2
                            ElseIf charColor = b_3c Then
                            brand = 3
                            Else
                            brand = 99
                            End If
                    Next i
                    modelArray(m) = Replace(modelArray(m), " ", "") ' Remove any spaces
                        If brand = 1 Then
                        modelArray(m) = b_1 & modelArray(m)
                        ElseIf brand = 2 Then
                        modelArray(m) = b_2 & modelArray(m)
                        ElseIf brand = 3 Then
                        modelArray(m) = b_3 & modelArray(m)
                        Else
                        modelArray(m) = b_99 & modelArray(m)
                        End If
                        brand = 0
                   Next m
     charPosition = 0
     rangeCell.Value = Join(modelArray, ",")
     rangeCell.Font.Color = 1
    End If
    
    Next rangeCell
    
    MsgBox "Done Tagging Models"
    
      Exit Sub
    ErrHandler:
       MsgBox "Error occurred"
       Resume Next
    End Sub
    

    I've hardly touched Visual Basic for years and years, so I suspect there's better ways of doing this, but at least this works - much better than doing it by hand!