Jaymes
Jaymes

Reputation: 37

Trying to compare cells in column a against cells in column b vba

I'm pretty new to VBA, and have been pretty successful in finding the answers I need, until now. I want to take one value in column A, and see if it appears in column B and perform an action when it does find the value and then go the next column in column B. I feel like I am close just not getting something right.

Here's what I've tried so far

Sub Macro1()
'
' Macro1 Macro            
    Dim currentA As String
    Dim currentB As String
    Dim a As Integer
    Dim b As Integer
    a = 2
    b = 1

    Do Until IsEmpty(ActiveCell)
        Cells(a, b).Select
        currentA = ActiveCell
        Debug.Print (currentA)
        a = a + 1

        Range("b2").Select            
        Do Until IsEmpty(ActiveCell)                
            currentB = ActiveCell                
            If currentA = currentB Then
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent1
                    .Color = 65535
                    .PatternTintAndShade = 0
                    .TintAndShade = 0
                End With
            End If

            Debug.Print (currentA)                   
            ActiveCell.Offset(1, 0).Select
        Loop                                       
    Loop
End Sub

Upvotes: 1

Views: 80

Answers (2)

Andy Brazil
Andy Brazil

Reputation: 36

Sub CompareCells()
Dim CellInColA As Range
Dim CellInColB As Range
  For Each CellInColA In Application.Intersect(ActiveSheet.UsedRange, Columns("A").Cells)
    For Each CellInColB In Application.Intersect(ActiveSheet.UsedRange, Columns("B").Cells)
      If CellInColB = CellInColA Then
        'found it - do whatever
        CellInColB.Interior.ColorIndex = 3
        Exit For
      End If
    Next CellInColB
  Next CellInColA
End Sub

Upvotes: 1

Vityata
Vityata

Reputation: 43595

Here is a possible solution of your problem, using as much from your code as possible:

Option Explicit

Sub TestMe()

    Dim currentA    As String
    Dim currentB    As String

    Dim a           As Long
    Dim b           As Long

    Dim cellA       As Range
    Dim cellB       As Range

    a = 2
    b = 1

    With ActiveSheet
        Set cellA = .Range("A2")

        Do Until IsEmpty(cellA)
            Set cellA = .Cells(a, b)
            a = a + 1

            Set cellB = .Range("B2")

            Do Until IsEmpty(cellB)
                If cellA.Value = cellB.Value Then
                    PaintMe cellA
                    PaintMe cellB
                End If

                Set cellB = cellB.Offset(1, 0)
            Loop
        Loop

    End With
End Sub

Public Sub PaintMe(cellA As Range)

    With cellA.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .Color = 65535
        .PatternTintAndShade = 0
        .TintAndShade = 0
    End With

End Sub

What I have done:

  1. The cells and the ranges are refered to the Activesheet with a dot.
  2. I have updated the loops, so they look better.
  3. I have made a special sub PaintMe that paints both the left and the right column.
  4. I have avoided using ActiveCell, because it is slow and difficult - see more here - How to avoid using Select in Excel VBA macros

That's a sample of the output:

enter image description here

In general, a solution like this is quite not professional, because it has an algorithm complexity of n², which is probably the worst case for this kind of problem. You have 2 loops within each other, and thats the slowest possible solution. There are much better ways to do it, in general. But for excel, it should work.

Upvotes: 0

Related Questions