Color the cells based on notepad color code

[dootzee84]

Dear All,

My name is Dusan and this is my first post in the forum. I have been using it for quite some time now, and the reason I am boring you with this question is because I have not been able to find the answer anywhere... Here it goes:

I have 50.000 lines in the .txt file (50.000 different colors, basically), where left column represents the color code, while the right columns represents the decimal value of the color:

Colr_code Rgb_colour
C3796 4861223
C3797 4729123
C3798 4728608
C3799 4662302
C3800 4464666
C3801 4267031
--------------

The excel file I use has cells with values seen in the left column (C3796, C3797....C3800, etc...).
I want to color the cell based on their values, but since I have 50.000 different colors, the "if" will not work, as the vba cannot handle more than 1.000 IF lines (maybe even less).

I have tried the following:

For Each c In selection
If c.Value = "C3796" Then c.Interior.Color = 4861223
If c.Value = "C3797" Then c.Interior.Color = 4729123
etc...

this works for the coloring, but I cannot put 50.000 IF lines in the VBA code.

So, I need to use the .txt file, but I do no know how to read the data and color the cells based on the data present in the .txt file.

I hope I was clear

Thank you very much in advance! ray:ray:ray:

Best regards,
Dusan

 

[Scott Huish]

Assuming you have that imported into the Excel spreadsheet already, why not just loop through the 2nd column and apply it to the first column. All those values appeared to be the same color visually to me though.

Sub test()
Dim c As Range
For Each c In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    c.Offset(, -1).Interior.Color = c
Next
End Sub

 

[dootzee84]

Dear Scott,

Thank you for your fast reply. Actually, your code helped me indirectly as I have made the following, which I think you will find interesting:

I have colored the cells containing codes (50.000 of them using you code) in Sheet1 in the .xlam file:

C3796
C3797
C3798
....

After that I inserted a code that colors selected cells whenever a cell has one of these values (C3796, C3797, etc) based on the interior color of the database cell:

Sub matchkolor()

Dim ws As Worksheet
Set ws = ActiveSheet

Set spisak = Selection

Workbooks("match kolor.xlam").Sheets("Sheet1").Activate
Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Select
Set baza = Selection

ws.Activate
Application.ScreenUpdating = False

Dim x, y, match As Long

For Each y In baza
    For Each x In spisak
        If x <> "" Then
            If x = y Then
               x.Select
               Selection.Interior.Color = y.Interior.Color
            End If
        End If
    Next
Next

End Sub

This code works fine for a relatively small number of selected cells.
But, if I select 100 cells, for example, the code takes 72 seconds to color them, which is very slow. For even bigger number, the macro crashes Excel
Do you have any idea how I could optimize the code?

Thank you!

Best regards,
Dusan

 

[Fluff]

How about

Sub dootzee()
    Dim Dic As Object
    Dim Cl As Range
    
    Application.ScreenUpdating = False
    Set Dic = createbject("Scripting.dictionary")
    With Workbooks("match kolor.xlam").Sheets("Sheet1")
        For Each Cl In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
            Dic.Item(Cl.Value) = Cl.Interior.Color
        Next Cl
    End With
    For Each Cl In Selection
        If Dic.exists(Cl.Value) Then Cl.Interior.Color = .Item(Cl.Value)
    Next Cl
End Sub

 

[dootzee84]

Hi Fluff!

Thank you very much for the code! It now works flawlessly and lighting fast! It takes only about 1 sec to color more than 200 cells!ray:

I just needed to correct one thing - to add "dic" in the dic.Item(Cl.Value):

If Dic.exists(Cl.Value) Then Cl.Interior.Color = .Item(Cl.Value)

Thank you very much!

Best regards,
Dusan

 

[Fluff]

You're welcome & thanks for the feedback