macro for repeat task and format interior

  • Thread starter Thread starter shiro
  • Start date Start date
S

shiro

Hi All,
I'm trying to check out repeated value on column Q and the hightlighted
entire cell on the left.I put the code that found from Sample,and trying
to modified it but I made a mistake.I can't select entire cell on the left,
I just can highlight 2 cell ( offset(0.-3) and the cell on column A).Please
help how to select entire cell to the left without interupted by blank cell.

And also I want to put the copy of higlighted cell value to a new workbook.

Thank's.

Rgds,


Shiro


Sub Duplicate_Serial_Number()

Dim eX As Integer
Dim cell_in_loop As Range

eX = ActiveSheet.Evaluate("COUNTIF(Q:Q,"">1"")")

If eX = 0 Then
MsgBox "There is no duplicated serial number ", vbExclamation _
+ vbOKOnly, "No Duplicated Data"
Else
For Each cell_in_loop In Range("Q16:Q50000")
If cell_in_loop.Value > 1 And _
cell_in_loop.Value <> "" Then
With cell_in_loop.Offset(0, -3).End(xlToLeft).Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End If
Next
End If
End Sub
 
One way:

Option Explicit
Sub Duplicate_Serial_Number()

Dim myCell As Range
Dim LastRow As Long
Dim myRng As Range
Dim myRngToShade As Range

With ActiveSheet
'clean up any previous shading
.Cells.Interior.ColorIndex = xlNone
LastRow = .Cells(.Rows.Count, "Q").End(xlUp).Row
Set myRng = .Range("Q16:Q" & LastRow)

If Application.Max(myRng) < 2 Then
MsgBox "There is no duplicated serial number ", vbExclamation _
+ vbOKOnly, "No Duplicated Data"
Else
For Each myCell In myRng.Cells
If myCell.Value > 1 Then
Set myRngToShade = .Range(.Cells(myCell.Row, "A"), _
.Cells(myCell.Row, "N"))
With myRngToShade.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End If
Next myCell
End If
End With

End Sub

=======
Colors are pretty, but I like to use that extra column (Q) and then use
data|Filter|autofilter to see the duplicates.
 
Back
Top