Help Required: EXCEL Macros (if..then & for..loop)

stitch · Dec 16, 2003

Hi,

I am currently trying to find duplicate records in a single worksheet that has over 12,000 records. I have sorted the data so that the duplicates should appear on the next line down. I would like to, if possible, create a macro to cycle through the records line by line and compare the two. If they are the same then change the colour on the duplicate row.

My idea was something like this:

For each row loop
if cell = (cell below) and (next cell) = (next cell below) then change colour
e.g. if B1 = C1 and B2 = C2 then change colour
end loop

I would appreciate any help that you can offer.

Many thanks,
Richard.

Bowers74 · Dec 16, 2003

Hey Stich,

Something like this could help, but only if the records stay sorted and the range you want to check is selected.

Code:

Sub HighlightDupes()
Dim c As Range, SearchRange As Range
Set SearchRange = Selection
For Each c In SearchRange
    If c = c.Offset(-1, 0) Then
        With c.Font
            .ColorIndex = 3
            .Bold = True
        End With
    End If
Next c
End Sub

I hope this helps!

Peace! [peace]

Mike

Never say Never!!!
Nothing is impossible!!!

dyarwood · Dec 16, 2003

Try

If Range("B1&quot

.Value = Range("C1&quot

.Value Then
If Range("B2&quot

.Value = Range("C2&quot

.Value Then

Range("whatever&quot

.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

This might work

dyarwood

Bowers74 · Dec 16, 2003

A slight adjustment, just in case you want to select the entire column:

Code:

Sub HighlightDupes()
Dim c As Range, SearchRange As Range
Set SearchRange = Selection

[/color red]On Error Resume Next[/color]

Code:

For Each c In SearchRange
    If c = c.Offset(-1, 0) Then
        With c.Font
            .ColorIndex = 3
            .Bold = True
        End With
    End If
Next c
End Sub

Peace!

Mike

Never say Never!!!
Nothing is impossible!!!

Bowers74 · Dec 16, 2003

A slight adjustment, just in case you want to select the entire column:

Code:

Sub HighlightDupes()
Dim c As Range, SearchRange As Range
Set SearchRange = Selection

On Error Resume Next

Code:

For Each c In SearchRange
    If c = c.Offset(-1, 0) Then
        With c.Font
            .ColorIndex = 3
            .Bold = True
        End With
    End If
Next c
End Sub

Sorry, It's been awhile! ;-) [blush]

Peace!

Mike

Never say Never!!!
Nothing is impossible!!!

stitch · Dec 16, 2003

Thanks guys for the very quick help.

Bowsers74 - I've managed to test your information and it seems to be working great and very close to what I need. However, I would like the loop to check every cell in the row against the cell directly below before changing the colour. At the moment it just appears to check the cell below and then change. I hope you understand my requirements.

Thanks again,
Stitch.

stitch · Dec 16, 2003

Sorry, I forgot to write I require something similar to Dyarwoods reply but without actually specifying the cell name. eg. B1 / B2. Mainly because I have 12,000+ records.

Thanks,
Stitch.

Bowers74 · Dec 16, 2003

Stitch

my macro checks the cell directly above each and every cell in the selected area and if it is the same, it changes the color and changes the font to bold. All you have to do is select the cells that you want to check (All of the cells for your 12,000+ records) and the macro does the rest.

What more do you want?

Maybe you should explain a little more in detail, if you need something better. Try experimenting with my and Dyarwood's code to see what you get.

Good Luck!

Peace! [peace]

Mike

Never say Never!!!
Nothing is impossible!!!

dyarwood · Dec 16, 2003

You could use the fact that

Range("B2&quot

.Value is the same as Cells(2,2).Value

If you then use i as a row value then do something like

If Cells(i,2).Value = Cells(i,3.Value Then
If Cells(i+1,2).Value = Cells(i+1,3).Value Then

Range("whatever&quot

.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Then use this in a do loop something like

Do Until IsEmpty(Cells(i,1))

might give you some ideas

dyarwood

stitch · Dec 16, 2003

Hi Bowers74,

If you can please see the below table for results that I am trying to achieve. You may have to save the information in a .html file and open within a browser.

It's quite difficult to explain but I would like to check 1 by 1 each row against the one below it. If every cell in this row is the same as every cell in the one below then highlight the row. After this the macro will move onto the next row and compare this to the one below, etc. The macro will finish after processing the last row.

Hopefully you can see that I am trying to highlight a complete row if it's the same as the one next to it. Currently your macro appears to highlight all cells where the above value equals the below value. Sorry if I incorrectly specified my initial requirements.

<TABLE border=1><TR><TD>Example Data<BR><BR>
<TABLE>
<TR><TD>Rec1</TD><TD>Rec2</TD></TR>
<TR><TD>1</TD><TD>1</TD></TR>
<TR><TD>1</TD><TD>1</TD></TR>
<TR><TD>1</TD><TD>2</TD></TR>
<TR><TD>2</TD><TD>2</TD></TR>
<TR><TD>2</TD><TD>3</TD></TR>
<TR><TD>3</TD><TD>3</TD></TR>
<TR><TD>4</TD><TD>4</TD></TR>
<TR><TD>4</TD><TD>4</TD></TR>
<TR><TD>5</TD><TD>5</TD></TR>
</TABLE>
</TD><TD>Results from your macro<BR><BR>
<TABLE>
<TR><TD>Rec1</TD><TD>Rec2</TD></TR>
<TR><TD>1</TD><TD>1</TD></TR>
<TR><TD><FONT Color=Red>1</TD><TD><FONT Color=Red>1</TD></TR>
<TR><TD><FONT Color=Red>1</TD><TD>2</TD></TR>
<TR><TD>2</TD><TD><FONT Color=#FF0000>2</FONT></TD></TR>
<TR><TD><FONT Color=Red>2</TD><TD>3</TD></TR>
<TR><TD>3</TD><TD><FONT Color=Red>3</TD></TR>
<TR><TD>4</TD><TD>4</TD></TR>
<TR><TD><FONT Color=Red>4</TD><TD><FONT Color=Red>4</TD></TR>
<TR><TD>5</TD><TD>5</TD></TR>
</TABLE>
</TD><TD>My expected results<BR><BR>
<TABLE>
<TR><TD>Rec1</TD><TD>Rec2</TD></TR>
<TR><TD>1</TD><TD>1</TD></TR>
<TR><TD><FONT Color=Red>1</TD><TD><FONT Color=Red>1</TD></TR>
<TR><TD>1</TD><TD>2</TD></TR>
<TR><TD>2</TD><TD>2</TD></TR>
<TR><TD>2</TD><TD>3</TD></TR>
<TR><TD>3</TD><TD>3</TD></TR>
<TR><TD>4</TD><TD>4</TD></TR>
<TR><TD><FONT Color=Red>4</TD><TD><FONT Color=Red>4</TD></TR>
<TR><TD>5</TD><TD>5</TD></TR>
</TABLE>
</TD></TR></TABLE>

Many thanks,
Stitch.

chandlm · Dec 16, 2003

Stitch,

You could try this.

Assuming that col a is rec1 and col b is rec2

Code:

Sub duplicates()
lr = Range(&quot;a65536&quot;).End(xlUp).Row

MsgBox lr

For A = lr To 2 Step -1
Range(&quot;a&quot; & A).Select

If Range(&quot;a&quot; & A).Value = Range(&quot;a&quot; & A - 1).Value And Range(&quot;b&quot; & A).Value = Range(&quot;b&quot; & A - 1).Value Then
Range(&quot;a&quot; & A).Font.ColorIndex = 3
Range(&quot;b&quot; & A).Font.ColorIndex = 3

End If
Next A

End Sub

HTH

Matt
[rockband]

chandlm · Dec 16, 2003

Sorry you can remove the msgbox line.

I left it in by accident

Matt
[rockband]

TonyJollans · Dec 16, 2003

Hi stitch,

If all you want to do is change the colour on rows which are the same as the one above (in columns B and C) you can do it with Conditional Formatting.

Select all but the first of your 12000 rows
Select Format > Conditional Formatting... from the Menu
Choose Formula Is under Condition 1
Enter =AND(B2=B1,C2=C1) in the text box on the right
Click on Format...
Choose the colour you want and press OK
Tab to the OK button and press Ctrl-Enter

Enjoy,
Tony

stitch · Dec 16, 2003

Hi Guys,

Thanks for all of your help. I have managed to fix my problem using the solution from chandlm, but have learnt a lot from each response. I just had to add extra conditions to include checks on each column between A & R, and then to highlight the dup row and insert "Dup" into a cell at the end of the row. I could then remove the records using a filter after examining them.

Thanks again for all your help, no doubt i'll need it again soon.

Stitch.

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Help Required: EXCEL Macros (if..then & for..loop)

stitch

Programmer

Bowers74

MIS

dyarwood

Programmer

Bowers74

MIS

Bowers74

MIS

stitch

Programmer

stitch

Programmer

Bowers74

MIS

dyarwood

Programmer

stitch

Programmer

chandlm

Programmer

chandlm

Programmer

TonyJollans

Programmer

stitch

Programmer

Similar threads

Part and Inventory Search

Sponsor

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Help Required: EXCEL Macros (if..then &amp; for..loop)

Programmer

MIS

Programmer

MIS

MIS

Programmer

Programmer

MIS

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Similar threads

Log in

Part and Inventory Search

Sponsor

Help Required: EXCEL Macros (if..then & for..loop)