Forum Discussion
Excel highlight numbers in range by input
I pretty much forgot about VBA, cause i was learning it in school.
But i like to do something in Excel.
Let's take a look at my tables from beginning.
This all is just for my lottery Statistics.
In table A i'm writing in numbers, which i have chosen in lottery tickets. (5 X 20 numbers )
In table B i'm writing those number which was drawn in TV lottery. (20+ NUMBERS)
So I want to make a VBA code to highlight cells in table A when the same number is written / inputted in table B. But i don't highlight any blank values, cause not always I'm playing all 5 variants in game, and not all N's are numbers in table B
For example, i input number 47 in table B, and it highlights all cells with number 47 in table A with green fill colour.
I've already made CountCColor in VBA, but i need to make VBA for automatically highlighting numbers inputted by me in B to A.
Conditional formatting is not good for this :D
For example Tables 2.
I bought 1 lottery ticket from possible 5. Have chosen my 20 numbers TableA. And numbers in TableB were drawn in lottery. I used Kutools trial there but, is it possible somehow to do that with built in Excel options or VBA?
I just need highlight numbers (green) in B4:F23 which will be or was inputted in H4:L23.
Thanks in advance :)
Happy holidays :)
Sorry, I didn't realize you had this on multiple worksheets in the workbook, changed to a workbook change event. So the code goes in ThisWorkbook. Added to what you had posted and attached.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim TicketRange As Range
Dim DrawRange As Range
Dim Cell As Range
Dim CheckRange As Range
Set TicketRange = Range("B4:F23")
Set DrawRange = Range("H4:L23")
For Each Cell In TicketRange
Set CheckRange = Range("H4:L23").Find(What:=Cell.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not CheckRange Is Nothing And Cell.Value <> "" Then
Cell.Interior.ColorIndex = 4
Else
Cell.Interior.ColorIndex = 0
End If
Next Cell
End Sub
11 Replies
Hi, Here are a couple of options, If you want to have the coloring happen only when you manually run the code stick this in a module:
Sub Color()
Dim TicketRange As Range
Dim DrawRange As Range
Dim Cell As Range
Dim CheckRange As Range
Set TicketRange = Range("B4:F23")
Set DrawRange = Range("H4:L23")
For Each Cell In TicketRange
Set CheckRange = Range("H4:L23").Find(What:=Cell.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not CheckRange Is Nothing And Cell.Value <> "" Then
Cell.Interior.ColorIndex = 4
End If
Next Cell
End Sub
Sub UnColor()
Dim TicketRange As Range
Dim Cell As Range
Set TicketRange = Range("B4:F23")
For Each Cell In TicketRange
Cell.Interior.ColorIndex = 0
Next Cell
End SubIf you want the code to run every time you change a cells value on the worksheet than stick this in the VBA for your worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TicketRange As Range
Dim DrawRange As Range
Dim Cell As Range
Dim CheckRange As Range
Set TicketRange = Range("B4:F23")
Set DrawRange = Range("H4:L23")
For Each Cell In TicketRange
Set CheckRange = Range("H4:L23").Find(What:=Cell.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not CheckRange Is Nothing And Cell.Value <> "" Then
Cell.Interior.ColorIndex = 4
Else
Cell.Interior.ColorIndex = 0
End If
Next Cell
End SubFor me is working only that Macro which i need to run manually.
Sorry, I didn't realize you had this on multiple worksheets in the workbook, changed to a workbook change event. So the code goes in ThisWorkbook. Added to what you had posted and attached.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim TicketRange As Range
Dim DrawRange As Range
Dim Cell As Range
Dim CheckRange As Range
Set TicketRange = Range("B4:F23")
Set DrawRange = Range("H4:L23")
For Each Cell In TicketRange
Set CheckRange = Range("H4:L23").Find(What:=Cell.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not CheckRange Is Nothing And Cell.Value <> "" Then
Cell.Interior.ColorIndex = 4
Else
Cell.Interior.ColorIndex = 0
End If
Next Cell
End Sub
Thanks for trying to help.
But nothing works for me.
Maybe i can send You a copy of my worksheet?
