mattneedshel
01-11-2013, 01:49 AM
A colleague wrote a macro for me (I don't really know VBA) to go through a list of about 12 columns, and in each column, where the number repeats for more than one cell, change the colour. So for example -
A1 -12
A2 -13
A3 -13
A4 -15
So in this case it would change cells A2 and A3 to a red background colour.
The only problem is, it doesn't appear to be working very well. In some areas it's working, some not. In some parts of the spreadsheet it'll highlight 2 cells with the same number, then further down it won't. Then in some areas, randomly it'll highlight one cell on its own as red in colour.
Would it be possible for someone to have a look at this code and help me with what I might need to change to get it working? Any help appreciated!
Dim LastRowCell As
Long
Dim LastCol As
Long
Range("A1").Select
LastCol = Cells("1",
Columns.Count).End(xlToLeft).Column
LastRowCell =
Cells(Rows.Count, "A").End(xlUp).Row
Range(Cells(1, 1),
Cells(LastRowCell, LastCol)).Select
With Selection
.Interior.ColorIndex =
xlNone
End With
Dim l As Long
Dim c As
Integer
Dim i As
Integer
Dim Values As
Range
Dim cell As
Range
l = 4 ' i is the number of
rows I want to go down column A
Range("B2").Select
For c = 2 To
LastCol
For i = 2 To
LastRowCell
Cells(i,
c).Select
Range(ActiveCell,
ActiveCell.Offset(l, 0)).Select
Set Values =
Selection
For Each cell In
Values
If
WorksheetFunction.CountIf(Values, cell.Value) >= 4 Then
cell.Interior.ColorIndex =
3
End If
Next cell
Next i
Next c
'Format Cells
Columns("A:Z").Select
With Selection
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
A1 -12
A2 -13
A3 -13
A4 -15
So in this case it would change cells A2 and A3 to a red background colour.
The only problem is, it doesn't appear to be working very well. In some areas it's working, some not. In some parts of the spreadsheet it'll highlight 2 cells with the same number, then further down it won't. Then in some areas, randomly it'll highlight one cell on its own as red in colour.
Would it be possible for someone to have a look at this code and help me with what I might need to change to get it working? Any help appreciated!
Dim LastRowCell As
Long
Dim LastCol As
Long
Range("A1").Select
LastCol = Cells("1",
Columns.Count).End(xlToLeft).Column
LastRowCell =
Cells(Rows.Count, "A").End(xlUp).Row
Range(Cells(1, 1),
Cells(LastRowCell, LastCol)).Select
With Selection
.Interior.ColorIndex =
xlNone
End With
Dim l As Long
Dim c As
Integer
Dim i As
Integer
Dim Values As
Range
Dim cell As
Range
l = 4 ' i is the number of
rows I want to go down column A
Range("B2").Select
For c = 2 To
LastCol
For i = 2 To
LastRowCell
Cells(i,
c).Select
Range(ActiveCell,
ActiveCell.Offset(l, 0)).Select
Set Values =
Selection
For Each cell In
Values
If
WorksheetFunction.CountIf(Values, cell.Value) >= 4 Then
cell.Interior.ColorIndex =
3
End If
Next cell
Next i
Next c
'Format Cells
Columns("A:Z").Select
With Selection
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select