Incorrect For Next Structure

[keith0528]

Greetings VBA'ers,

I have some really cool code that compares 2 columns and if they don't match it colors them red. There is even a nifty column number to letter conversion Function. But there is a problem with the For Next set up.
I need to be comparing row A2 with row B2, row A3 with row B3 etc. The first pass is right but then the 2nd pass onward its comparing row A2 with B3, then A2 with B4 etc. The 1st For Next doesn't run again. Can someone please show me how to correct this and help yourself to the code if you like.

Sub CompareColumnValues()
Dim ColumnNumber As Integer
Dim LstRw As Integer
Dim NumtoCol As String
Dim Found1 As Range
Dim CompareString As String
Dim rng1 As Range, rng2 As Range, i As Integer, j As Integer
LstRw = ActiveSheet.Range("A65536").End(xlUp).Row
'MyString = Left(Range("B2"), InStr(Range("B2"), "_") - 1)
'MyString = Split(Range("B3"), "_")(0)
Set Found1 = Cells.Find(What:="Ticket_Carrier", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
       False, SearchFormat:=False)
       
       Found1.Select
       ColumnNumber = Selection.Column
       
       
    'call to function, convert column number to letter
    NumtoCol = ConvertToLetter(ColumnNumber)
    
   
    If Found1 Is Nothing Then
        MsgBox "Ticket_Carrier column not found"
    End If
    
    For i = 2 To Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
        Set rng1 = Sheets("Sheet1").Range("A" & i)
        
        For j = 2 To Sheets("Sheet1").Range(NumtoCol & Rows.Count).End(xlUp).Row
            Set rng2 = Sheets("Sheet1").Range(NumtoCol & j)
            
            
            CompareString = Split(Range(NumtoCol & j), "_")(0)
            'rng2 = CompareString
            
            If CompareString = rng1 Then
                'nothing
            Else
                rng1.Interior.Color = RGB(255, 0, 0)
            End If
                     
            'Set rng2 = Nothing
            'Set rng1 = Nothing
        Next j
        
    Next i
End Sub
Function ConvertToLetter(iCol As Integer) As String
   Dim iAlpha As Integer
   Dim iRemainder As Integer
   iAlpha = Int(iCol / 27)
   iRemainder = iCol - (iAlpha * 26)
   If iAlpha > 0 Then
      ConvertToLetter = Chr(iAlpha + 64)
   End If
   If iRemainder > 0 Then
      ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
   End If
End Function

thanks

 

[shg]

You're welcome.