View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Don Guillett[_2_] Don Guillett[_2_] is offline
external usenet poster
 
Posts: 1,522
Default trying to highlight records with at least 3 same value

sub colormatchingrowsSAS()
for i = 4 to 44 'rows to check
if cells(i,1)=cells(i+1,1) and _
cells(i,2)=cells(i+2,1) and +
cells(i,3)=cells(i+3,1) then
cells(i,1).resize(,3).interior.colorindex=6
end if
next i
end sub
--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Stefano" wrote in message
...
On Apr 4, 7:45 pm, JLatham wrote:
EXACTLY 3 of the same value? Or 3 or more? What columns are involved?
Is
there a column that would always have an entry in it for any row with any
data in it? If so, which column would that be?

I've assumed column A will always have an entry on any row with any
entries
in it, and that you want to cells shaded yellow, and that you want to do
all
of this when the match count is 3 or more.

To check out the code:
Make a copy of your workbook. With the copy open, press [Alt]+[F11] to
open
the VB Editor and then choose Insert--Module and copy the code below and
paste it into the module presented to you. Make any edits needed to the
code. Close the VB Editor. Select the sheet you want this to work on
and
[Run] the macro from Tools -- Macro -- Macros (Excel 2003 & earlier) or
from the [Developer] tab in Excel 2007.

Sub MarkRows()
'works with the selected sheet
'the next Const identifies the
'column that will always have
'some entry in it on every row used
'change as required
Const keyCol = "A"
Dim lastRow As Long
Dim lastColAddr As String
Dim testRange As Range
Dim anyTestCell As Range
Dim matchCount As Double
Dim LC As Integer
Dim testCells As String
Dim matchCell As String

lastRow = Range(keyCol & Rows.Count).End(xlUp).Row
'change "1:" to "2:" if you have labels in row 1
Set testRange = Range(keyCol & "1:" & _
keyCol & lastRow)
Application.ScreenUpdating = False
For Each anyTestCell In testRange
anyTestCell.EntireRow.Interior.ColorIndex = xlNone
lastColAddr = anyTestCell.Offset(0, Columns.Count - _
anyTestCell.Column).End(xlToLeft).Address
matchCount = 0 ' reset
If Range(lastColAddr).Column 2 Then
For LC = 1 To Range(lastColAddr).Column
testCells = "A" & anyTestCell.Row & ":" & _
lastColAddr
matchCell = Cells(anyTestCell.Row, LC).Address
matchCount = _
WorksheetFunction.CountIf(Range(testCells), _
Range(matchCell))
If matchCount = 3 Then
Exit For
End If
Next
End If
If matchCount = 3 Then
anyTestCell.EntireRow.Interior.ColorIndex = 6 ' yellow
End If
Next
Set testRange = Nothing
End Sub

"Stefano" wrote:
Hi to everyone in this forum!
I'm really driving mad to find out a way to highlight any row in my
worksheet that has 3 same value.
A value can be both numbers or text.


Does anyone to know how to write a piece of VB code to accomplish that
job with Excel 2003?


Any help will be appreciated!
Bye,
Stefano.
.


@Don Guillett and @JLatham
thanks both of you for the reply!

that's an example to you:
---------------------------------------------------------------------------------------------------------
A B D
--------------------------------------
John 3 100,50
--------------------------------------
John 3 100,50 -----------------------------------
(that's a duplicate and it has to be yellow highlighted)
--------------------------------------
John 3 200,70 -----------------------------------
(that's NOT a duplicate, because column C has a different value)
--------------------------------------
John 5 200,70 -----------------------------------
(that's NOT a duplicate, because column C has a different value)
--------------------------------------
Carl 5 900,20 -----------------------------------
(that's NOT a duplicate, because column C has a different value)
--------------------------------------

the very last thing is:
it will be great if I could run the macro only on selected rows and
not to all the worksheet.

P.S.
@JLatham
I fired your code it's work but it's not seem to highlight what I want

Thank you very much indeed for your help, i really appreciate that
Stefano.