CODEWITHSUNDEEP
vbaexcelexcel-2010
Ahmad
Ahmad

Reputation: 13406

How to find value of one column in another and change color?

I'm new to Excel Macro VBA, so please bear with me.

I have an Excel file set up like this:

Col1    Col2
----    ----
a       a
b       c
c       e
d       g
e       i
f
g
h
i
j

I want to write a VBA macro function that will find values present in Col2, in Col1, and if it is found, then it will set the font color of that cell to red, in Col1 ..

So for the example data above, values a, c, e, g, i in Col1 should turn to red color.

For the above example, let's say that Col1 values are from A3:A13, and Col2 is from B3:B13 ..

I'm using Excel 2010 ..

How can I accomplish this in Excel VBA Macro ?

Upvotes: 0

Views: 4823

Answers (4)

Eddie
Eddie

Reputation: 621

Here's another option. It might not be pretty but just goes to show how many different ways there are of achieving the same solution.

Sub updateFontColour()

Dim rngCol1 As Range
Dim rngCol2 As Range
Dim myvalue As Long
Dim c As Range

'Set the ranges of columns 1 and 2. These are dynamic but could be hard coded
Set rngCol1 = ThisWorkbook.Sheets("Sheet1").Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)
Set rngCol2 = ThisWorkbook.Sheets("Sheet1").Range("B3:B" & Range("B" & Rows.Count).End(xlUp).Row)

'Loop through range 1 (column A) and use the 'Match' function to find a match in range 2 (column B)
For Each c In rngCol1
    On Error Resume Next
    'I use the error handler as the match function returns a relative position and not an absolute one.
    If IsError(myvalue = WorksheetFunction.Match(c.Value, rngCol2, 0)) Then
        'Do noting, just move next
    Else
        c.Font.Color = vbRed
    End If

Next

End Sub

Upvotes: 0

rangan
rangan

Reputation: 41

A simple few lines of macro would resolve the problem as under:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Integer, j As Integer
For j = 1 To Cells(1, 2).End(xlDown).Row
    For i = 1 To Cells(1, 1).End(xlDown).Row
       If Cells(j, 2) = Cells(i, 1) Then
         Cells(i, 1).Font.ColorIndex = 3
       End If
    Next
Next
End Sub

Upvotes: 0

Raybarg
Raybarg

Reputation: 720

I wanted to test my skills a little with this, even though @matzone gave exact answer already. I made this Sub which does exactly the same, but using Range objects and .Find() method. With comments...

Private Sub Test()
    FindAndColorMatchesOfTwoColumns "A", "B"
End Sub

Private Sub FindAndColorMatchesOfTwoColumns(colTarget As String, colList As String)
    Dim rLookUp As Range        ' Column range for list compared against
    Dim rSearchList As Range    ' Column range for compare items
    Dim rMatch As Range
    Dim sAddress As String

    ' Set compared against list from colTarget column
    Set rLookUp = Range(colTarget & "1:" & _
                  colTarget & Range(colTarget & "1").End(xlDown).Row)

    ' Loop trough list from colList column
    For Each rSearchList In Range(colList & "1:" & colList & Range(colList & "1").End(xlDown).Row)

        ' Find for a match
        Set rMatch = rLookUp.Find(rSearchList.Value, LookAt:=xlWhole)
        If Not rMatch Is Nothing Then
            ' Store first address found
            sAddress = rMatch.Address

            ' Loop trough all matches using .FindNext,
            '   exit if found nothing or address is first found
            Do
                ' Set the color
                rMatch.Font.Color = vbRed

                Set rMatch = rLookUp.FindNext(rMatch)

            Loop While Not rMatch Is Nothing And rMatch.Address <> sAddress
        End If
    Next

    Set rMatch = Nothing
    Set rSearchList = Nothing
    Set rLookUp = Nothing
End Sub

The idea is to be more dynamic, accept the two columns as arguments, set search ranges until Range.End(xlDown).Row and not fixed counts. Also loop trough only matches.

For original question the simple .Cells() nested loops is way simpler, but using .Find() would prove alot faster if column counts would go up to thousand(s).

Tested the "long list" hypothesis with this test sub:

Private Sub RunTest()
    Dim tStart As Date
    Dim tEnd As Date

    tStart = Timer
    FindAndColorMatchesOfTwoColumns "A", "B"
    tEnd = Timer

    Debug.Print Format(tEnd - tStart, "0.000")


    tStart = Timer
    Test
    tEnd = Timer

    Debug.Print Format(tEnd - tStart, "0.000")
End Sub

Added 1500 rows to column A and 184 rows to column B and got Immediate view result as:

0,266
12,719

So there indeed is a huge difference in performance... If OP was only providing simplistic example for question and intends to utilize this in larger sets of data.

Upvotes: 0

matzone
matzone

Reputation: 5719

I make it pink .. Cell A1:A10 .. Cell B1:B5 ..

Sub Test()
Dim x1, x2 As Integer

For x2 = 1 To 5
  For x1 = 1 To 10
    If Range("A" & Format(x1)).Value = Range("B" & Format(x2)).Value Then          
       Range("A" & Format(x1)).Font.Color = vbRed
    End If
  Next
Next
End Sub

Upvotes: 2

Related Questions