Loop in VBA Help

[wildcatcrazy]

I have some oracle/sql background knowledge, and now I'm venturing off in the world of VBA. I have a statement started, but need help writing the loop for the last piece of code where I compare two rows to identify differences. Here is what I currently have:

Columns("A:C").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlUnique
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

Range("A1:AD1048576").Select
Range("E4").Activate
ActiveSheet.Range("$A$1:$AD$1048576").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7 _
, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30), Header _
:=xlYes
Rows("2:3").Select
Selection.ColumnDifferences(ActiveCell).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Rows("2:3").Select
Selection.ColumnDifferences(ActiveCell).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Rows("4:5").Select
Selection.ColumnDifferences(ActiveCell).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With

SO ON AND SO ON.............

 

[wildcatcrazy]

And, it would be really cool if I could just cut/paste the unique records to sheet 2 instead of just highlighting them.

 

[Norie]

If you use Advanced Filter you can copy the unique items to another sheet.

Not 100 % sure how you want to get the uniques so I've posted 2 versions, first one that does individual columns:

Dim rng As Range
Dim LastRow
 
    Set rng = Sheets("Sheet1").Range("A1")
 
    While rng.Value <> ""
        LastRow = Sheets("Sheet1").Cells(Rows.Count, rng.Column).End(xlUp).Row
        rng.Resize(LastRow).AdvancedFilter xlFilterCopy, , Sheets("Sheet2").Range(rng.Address), Unique:=True
 
        Set rng = rng.Offset(, 1)

    Wend
 
End Sub

and the second which does the whole range:

Dim rng As Range
Dim LastCol As Long
Dim LastRow As Long
 

    LastCol = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column

    LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
 
    Set rng = Sheets("Sheet1").Range("A1").Resize(LastRow, LastCol)
 
    rng.AdvancedFilter xlFilterCopy, , Sheets("Sheet2").Range("A1").Resize(, LastCol), Unique:=True

 

[wildcatcrazy]

If you use Advanced Filter you can copy the unique items to another sheet.

Not 100 % sure how you want to get the uniques so I've posted 2 versions, first one that does individual columns:

Dim rng As Range
Dim LastRow
 
    Set rng = Sheets("Sheet1").Range("A1")
 
    While rng.Value <> ""
        LastRow = Sheets("Sheet1").Cells(Rows.Count, rng.Column).End(xlUp).Row
        rng.Resize(LastRow).AdvancedFilter xlFilterCopy, , Sheets("Sheet2").Range(rng.Address), Unique:=True
 
        Set rng = rng.Offset(, 1)

    Wend
 
End Sub

and the second which does the whole range:

Dim rng As Range
Dim LastCol As Long
Dim LastRow As Long
 

    LastCol = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column

    LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
 
    Set rng = Sheets("Sheet1").Range("A1").Resize(LastRow, LastCol)
 
    rng.AdvancedFilter xlFilterCopy, , Sheets("Sheet2").Range("A1").Resize(, LastCol), Unique:=True

The last version works great for what I want, thanks! Is there a way I can create a loop that compares two rows (2 to 3, 4 to 5, 6 to 7, etc...) and then continues until the last row? I need to start at row 2 since I have a header row.

 

[Norie]

Compare them how?

Also when would you be comparing them?

If it's after the filter for uniques do you want to compare and identify the differences between the records?

eg look for all the fields that are different in row 2 and 3

 

[wildcatcrazy]

I need to compare the two rows after the unique rows are removed. The comparison should catch any column differences and highlight them in yellow. What I am doing is merging yesterdays spreadsheet with todays and looking for unique records, and highlighting the differences. What you are not seeing is that I sort the data by 3 columns first before I run the macro.