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:
[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:
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.
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!