Color the cells based on notepad color code

dootzee84

New Member
Joined
Nov 8, 2019
Messages
3
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! :pray::pray::pray:

Best regards,
Dusan
 

Some videos you may like

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Scott Huish

MrExcel MVP
Joined
Mar 17, 2004
Messages
19,937
Office Version
365, 2010
Platform
Windows
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.
Code:
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
 
Last edited:

dootzee84

New Member
Joined
Nov 8, 2019
Messages
3
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:

Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
35,764
Office Version
365
Platform
Windows
How about
Code:
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

New Member
Joined
Nov 8, 2019
Messages
3
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!:pray:(y):)

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

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

Thank you very much!

Best regards,
Dusan
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
35,764
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,089,751
Messages
5,410,228
Members
403,304
Latest member
pajg

This Week's Hot Topics

Top