Duplicates in Excel 1

[darinmc]

Hi
I have VERY BASIC knowledge with excel coding... The below code was written for me and I have tried to adapt it BUT its just not working.

64 1 50 5.35
64 1 32 5.35
55 1 32 5.35
56 1 32 5.35
58 1 32 5.35
91 1 32 5.35
91 1 50 5.35
97 1 32 5.35
98 1 32 5.35
98 1 32 5.35
99 1 32 5.35
100 1 32 5.35

I simply need it to fill the rows with color which are duplicates
WHERE
Col A number are equal (i.e. 64 = 64)
AND
Col B has a number 1 (This part seems to be ok)

Sub Duplicate()
Dim LastUsedRow As Long
Dim i As Long
Dim j As Long

   Application.ScreenUpdating = False
   With Worksheets("Sheet1")
     LastUsedRow = .Cells(65536, 1).End(xlUp).Row
     If LastUsedRow > 1 Then
       i = 2
       Do
         If .Cells(i, 1).Value = .Cells(i, 1).Value And .Cells(i, 2) = 1 Then
 .Range(.Cells(i, 1), .Cells(i, 4)).Interior.ColorIndex = 19
           LastUsedRow = LastUsedRow + 1
         End If
         i = i + 1
       Loop Until i > LastUsedRow
     End If
   End With
   Application.ScreenUpdating = True
End Sub

Thx for ur help, VERY appreciated

Darin

 

[PHV]

...
   With Worksheets("Sheet1")
     LastUsedRow = .Cells(65536, 1).End(xlUp).Row
     For i = 2 To LastUsedRow
       If .Cells(i, 1).Value = .Cells(i - 1, 1).Value And .Cells(i, 2) = 1 Then
         .Range(.Cells(i - 1, 1), .Cells(i, 4)).Interior.ColorIndex = 19
       End If
     Next
   End With
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[darinmc]

Thanks, Great stuff

Drin

 

[AnotherHiggins]

You could accomplish this with Excel's built in conditional formatting without using VBA at all.

- Single Click on A1
- Format > Conditional Formatting
- Change first box to Formula Is
- In the second box, paste in the following:
[tab][COLOR=blue white]=And(countif($A:$A,$A1)>1,$B1=1)[/color]
- Go to the Patterns tab, select desired fill color

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[darinmc]

I have the code which ajusts my data and then i ran a second macro Duplicate Colour...

The duplicates need to be run 3 times
I tried modifying it so that all my code looks like the BELOW CODE:

HOWEVER This is what happens after running it...

64 1 2 £5.52
64 1 7.5 £5.70
64 1 34.5 £6.40
64 3 3.75 £7.00
64 4 3.75 £9.00
116 1 37.5 £7.00
898 1 46 £5.52
901 1 37 £7.40
920 1 15 £5.52
1077 1 2.5 £5.52
1077 3 2 £7.00
1106 1 39 £5.52
1106 3 3.5 £7.00


The FIRST macro yellow seems to be working
i.e. finds duplicates WHERE 1st Col: Number = Number AND 2nd Col = 1
this doesnt seem to work with the other colours.

I have changed the code for duplicateColorsOT2 and OT3 (last repeats of code) showing 2nd Col = 3
AND
2nd Col = 4

Sub AdjustData()
Dim LastUsedRow As Long
Dim i As Long
Dim j As Long

   Application.ScreenUpdating = False
   With Worksheets("Sheet1")
     LastUsedRow = .Cells(65536, 1).End(xlUp).Row
     If LastUsedRow > 1 Then
       i = 2
       Do
         If .Cells(i, 2).Value = 1 And .Cells(i, 3) > 37.5 Then
           j = i + 1
           .Cells(j, 1).EntireRow.Insert
           .Cells(j, 1).Value = .Cells(i, 1).Value
           .Cells(j, 2).Value = 2
           .Cells(j, 3).Value = .Cells(i, 3).Value - 37.5
           .Cells(i, 3) = 37.5
           .Cells(j, 4).Value = .Cells(i, 4).Value
           i = j
           LastUsedRow = LastUsedRow + 1
         End If
         i = i + 1
       Loop Until i > LastUsedRow
     End If
   End With
   Application.ScreenUpdating = True
End Sub

Sub DuplicatesColor()
Dim LastUsedRow As Long
Dim i As Long
Dim j As Long

   Application.ScreenUpdating = False

With Worksheets("Sheet1")
     LastUsedRow = .Cells(65536, 1).End(xlUp).Row
     For i = 2 To LastUsedRow
       If .Cells(i, 1).Value = .Cells(i - 1, 1).Value And .Cells(i, 2) = 1 Then
         .Range(.Cells(i - 1, 1), .Cells(i, 4)).Interior.ColorIndex = 6
       End If
     Next
   End With
   
   Application.ScreenUpdating = True
End Sub

Sub DuplicatesColorOtime1()
Dim LastUsedRow As Long
Dim i As Long
Dim j As Long

   Application.ScreenUpdating = False

With Worksheets("Sheet1")
     LastUsedRow = .Cells(65536, 1).End(xlUp).Row
     For i = 2 To LastUsedRow
       If .Cells(i, 1).Value = .Cells(i - 1, 1).Value And .Cells(i, 2) = 3 Then
         .Range(.Cells(i - 1, 1), .Cells(i, 4)).Interior.ColorIndex = 18
       End If
     Next
   End With
   
   Application.ScreenUpdating = True
End Sub


Sub DuplicatesColorOtime2()
Dim LastUsedRow As Long
Dim i As Long
Dim j As Long

   Application.ScreenUpdating = False

With Worksheets("Sheet1")
     LastUsedRow = .Cells(65536, 1).End(xlUp).Row
     For i = 2 To LastUsedRow
       If .Cells(i, 1).Value = .Cells(i - 1, 1).Value And .Cells(i, 2) = 4 Then
         .Range(.Cells(i - 1, 1), .Cells(i, 4)).Interior.ColorIndex = 18
       End If
     Next
   End With
   
   Application.ScreenUpdating = True
End Sub

Appreciate HELP PLEASE and if posible, do all the color coding as 1 macro if possible???

Thx

Darin

 

[ck1999]

Sub DuplicatesColorOtime1()
Dim LastUsedRow As Long
Dim i As Long
Dim j As Long

   Application.ScreenUpdating = False

With Worksheets("Sheet1")
     LastUsedRow = .Cells(65536, 1).End(xlUp).Row
     For i = 2 To LastUsedRow
       If .Cells(i, 1).Value = .Cells(i - 1, 1).Value And .Cells(i, 2).Value = .Cells(i - 1, 2).Value Then
       
    Select Case .Cells(i, 2)
        Case 1:         .Range(.Cells(i - 1, 1), .Cells(i, 4)).Interior.ColorIndex = 6
        Case 3:         .Range(.Cells(i - 1, 1), .Cells(i, 4)).Interior.ColorIndex = 18
        Case 4:        .Range(.Cells(i - 1, 1), .Cells(i, 4)).Interior.ColorIndex = 16
    End Select
       End If
     Next
   End With
   
   Application.ScreenUpdating = True
End Sub

i changed color for if col b = 4 so it is a different color than if col b = 3

ck1999

 

[darinmc]

Thx
Worked well