Colour coding unique number values

[spy2300]

Hi everyone,

I am new here and in need of your expertise. I recently watched https://youtu.be/u8F7U7W6ka4 where Bill instructs how to create a VBA to colour code unique number values within excel....perfect! The problem I am now having is that when I receive an excel worksheet it is already pre-populated with data and I want to run the VBA through the data that is there. I had thought I could just open the excel and then paste the VBA however, that does not work. I also tried copying the data from one book, creating a second book with the VBA present and then pasting the data in and it did work up to 28 lines only. The rest of the data did not follow the VBA rules. Here is the VBA I am using

Private Sub Worksheet_Change(ByVal Target As Range)
Set WF = Application.WorksheetFunction
If Target.Cells.Count = 1 Then
If Target.Column = 1 Then
x = 0
On Error Resume Next
x = WF.Match(Target.Value, _
Range("A1").Resize(Target.Row - 1), _
0)
On Error GoTo 0
If x > 0 Then
' duplicate value... copy the old color
Target.Interior.Color = Cells(x, 1).Interior.Color
Else
' Choose a new color
Target.Interior.Color = RGB( _
WF.RandBetween(0, 256), _
WF.RandBetween(0, 256), _
WF.RandBetween(0, 256))
End If
End If
End If
End Sub

If someone could help me figure out how to run the VBA over top of data that is already populated that would be great....in addition how to get it to work for more than 28 lines. As a side note - if I started to manually type different numbers the VBA was working but, as I said, for some reason the VBA is simply not running beyond 28 lines when large data sets are already present.

Thank you all!

 

[Yongle]

Welcome to the forum
Try something like this

Sub CallIt()
    Dim cell As Range
    For Each cell In Range("A1:A100")
        Call MySub(cell)
    Next
End Sub

Private Sub MySub(ByVal Target As Range)
    Dim WF, x
    Set WF = Application.WorksheetFunction
    If Target.Cells.Count = 1 Then
        If Target.Column = 1 Then
            x = 0
            On Error Resume Next
            x = WF.Match(Target.Value, Range("A1").Resize(Target.Row - 1), 0)
            On Error GoTo 0
            If x > 0 Then
            ' duplicate value... copy the old color
                Target.Interior.Color = Cells(x, 1).Interior.Color
            Else
                ' Choose a new color
                Target.Interior.Color = RGB(WF.RandBetween(0, 256), WF.RandBetween(0, 256), WF.RandBetween(0, 256))
            End If
        End If
    End If
End Sub

 

[spy2300]

Hi Yongle!

Thanks for the suggestion! Forgive this NEWB but when I copy your code and put it into the VBA editor what option should I select in terms of worksheet / general...would it be a change, table update, calculate etc. I did try using your code (pasting it in as general) but I did not notice that my excel file updated. In addition does your code only code up to 100 cells? I would need a much larger amount if so.

Welcome to the forum
Try something like this

Sub CallIt()
    Dim cell As Range
    For Each cell In Range("A1:A100")
        Call MySub(cell)
    Next
End Sub

Private Sub MySub(ByVal Target As Range)
    Dim WF, x
    Set WF = Application.WorksheetFunction
    If Target.Cells.Count = 1 Then
        If Target.Column = 1 Then
            x = 0
            On Error Resume Next
            x = WF.Match(Target.Value, Range("A1").Resize(Target.Row - 1), 0)
            On Error GoTo 0
            If x > 0 Then
            ' duplicate value... copy the old color
                Target.Interior.Color = Cells(x, 1).Interior.Color
            Else
                ' Choose a new color
                Target.Interior.Color = RGB(WF.RandBetween(0, 256), WF.RandBetween(0, 256), WF.RandBetween(0, 256))
            End If
        End If
    End If
End Sub

 

[Yongle]

when I copy your code and put it into the VBA editor what option should I select in terms of worksheet / general...would it be a change, table update, calculate etc.

to get a list of macros to run {ALT}{F8}
and run CallIt

Placed in a STANDARD module it runs against the active sheet
Placed in a SHEET module it runs agains that sheet

In addition does your code only code up to 100 cells? I would need a much larger amount if so.

amend the range to the range that you want

 

[spy2300]

Hi Yongle,

Sorry to say but the solution you presented isn't working for me. It is likely because I am doing something wrong (sorry). Is there any other way to accomplish what I am looking to do? Ie - Is it possible to amend the original code I posted so that it runs on the data that is already input in my excel sheet?

Thank you kindly!

to get a list of macros to run {ALT}{F8}
and run CallIt

Placed in a STANDARD module it runs against the active sheet
Placed in a SHEET module it runs agains that sheet



amend the range to the range that you want

 

[Yongle]

Add a new sheet
Insert the code provided into that sheet's module (not a standard module)
Run macro CallIt

 

[spy2300]

Amazing! I finally figured it out. I appreciate your help more than you know

 

[Yongle]

Glad you got there