Small Macro Revision - to highlight rows and enter how many times they appear in a cell rather than

A

amorrison2006

Hello

I have this macro which works the way I want but does not report on
it's findings in the way I need it to. My rows containing valued in
cells A B C and D should match three times. If they do not match
three times then that means I am missing transactions. This macro
only gives me a message box and tells me how many times the rows
appear.....I need the macro to highlight or enter a value in column F
as to how many times it does appear so I can then filter out the
transactions rather than right the row numbers does......

Someone please help.....I would be ever so grateful.

I tried to do this myself but not working at all.

Thanks,

Andrea

Sub findtriples()


Lastrow = Cells(Rows.Count, "A").End(xlUp).Row


For RowCount = 1 To Lastrow


'Make sure data didn't appear earlier
Found = False
For OldRowCount = 1 To (RowCount - 1)
If Cells(RowCount, "A") = Cells(OldRowCount, "A") And _
Cells(RowCount, "B") = Cells(OldRowCount, "B") And _
Cells(RowCount, "C") = Cells(OldRowCount, "C") Then


Found = True
Exit For
End If
Next OldRowCount


If Found = False Then
'Count number of times combination is found
TimesFound = 1
RowsFound = CStr(RowCount)
For NewRowCount = (RowCount + 1) To Lastrow


If Cells(RowCount, "A") = Cells(NewRowCount, "A") And _
Cells(RowCount, "B") = Cells(NewRowCount, "B") And _
Cells(RowCount, "C") = Cells(NewRowCount, "C") Then


TimesFound = TimesFound + 1
RowsFound = RowsFound & "," & CStr(NewRowCount)
End If
Next NewRowCount


ABCData = CStr(Cells(RowCount, "A")) & ", " & _
CStr(Cells(RowCount, "B")) & ", " & _
CStr(Cells(RowCount, "C"))
MsgBox ("Row " & CStr(RowCount) & _
" data was found " & CStr(TimesFound) & _
" time(s)" & Chr(10) & _
"Data = " & ABCData & Chr(10) & _
"Row(s) = " & RowsFound)
End If


Next RowCount


End Sub
 
P

paul.robinson

Hi
One new line should do it. It puts your count of repeat data on each
row in column F.
regards
Paul

Sub findtriples()


Lastrow = Cells(Rows.Count, "A").End(xlUp).Row


For RowCount = 1 To Lastrow


'Make sure data didn't appear earlier
Found = False
For OldRowCount = 1 To (RowCount - 1)
If Cells(RowCount, "A") = Cells(OldRowCount, "A") And _
Cells(RowCount, "B") = Cells(OldRowCount, "B") And _
Cells(RowCount, "C") = Cells(OldRowCount, "C") Then


Found = True
Exit For
End If
Next OldRowCount

If Found = False Then
'Count number of times combination is found
TimesFound = 1
RowsFound = CStr(RowCount)
For NewRowCount = (RowCount + 1) To Lastrow


If Cells(RowCount, "A") = Cells(NewRowCount, "A") And _
Cells(RowCount, "B") = Cells(NewRowCount, "B") And _
Cells(RowCount, "C") = Cells(NewRowCount, "C") Then


TimesFound = TimesFound + 1
RowsFound = RowsFound & "," & CStr(NewRowCount)
End If
Next NewRowCount
'***********New line******
Cells(RowCount,"F").Value = TimesFound

ABCData = CStr(Cells(RowCount, "A")) & ", " & _
CStr(Cells(RowCount, "B")) & ", " & _
CStr(Cells(RowCount, "C"))
MsgBox ("Row " & CStr(RowCount) & _
" data was found " & CStr(TimesFound) & _
" time(s)" & Chr(10) & _
"Data = " & ABCData & Chr(10) & _
"Row(s) = " & RowsFound)
End If


Next RowCount


End Sub
 
R

Roger Govier

Hi Andrea

I am assuming you want a check mark ( I have used "x"), to appear
against each row that matches 3 times, but rows that don't match, leave
blank.
If so, this modification to the code you had been given should work. I
have remmed out the message box part, but you can remove the rem marks
to display it if you want.

Sub findtriples()
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For RowCount = 1 To Lastrow
'Make sure data didn't appear earlier
Found = False
For OldRowCount = 1 To (RowCount - 1)
If Cells(RowCount, "A") = Cells(OldRowCount, "A") And _
Cells(RowCount, "B") = Cells(OldRowCount, "B") And _
Cells(RowCount, "C") = Cells(OldRowCount, "C") Then

Found = True
Exit For
End If
Next OldRowCount

If Found = False Then
'Count number of times combination is found
TimesFound = 1
rowsfound = CStr(RowCount)
For NewRowCount = (RowCount + 1) To Lastrow

If Cells(RowCount, "A") = Cells(NewRowCount, "A") And _
Cells(RowCount, "B") = Cells(NewRowCount, "B") And _
Cells(RowCount, "C") = Cells(NewRowCount, "C") Then

TimesFound = TimesFound + 1
rowsfound = rowsfound & "," & CStr(NewRowCount)
End If
Next NewRowCount

If TimesFound = 3 Then
Cells(Left(rowsfound, 1), 6) = "x"
Cells(Mid(rowsfound, 3, 1), 6) = "x"
Cells(Right(rowsfound, 1), 6) = "x"
End If
' ABCData = CStr(Cells(RowCount, "A")) & ", " & _
' CStr(Cells(RowCount, "B")) & ", " & _
' CStr(Cells(RowCount, "C"))
' MsgBox ("Row " & CStr(RowCount) & _
' " data was found " & CStr(Timesfound) & _
' " time(s)" & Chr(10) & _
' "Data = " & ABCData & Chr(10) & _
' "Row(s) = " & rowsfound)
End If

Next RowCount

End Sub
 
A

amorrison2006

Paul,

You really are a star.....can one adjustment be made? I dont know how
difficult it is,

If this macro runs it will place the value in the cell but then skips
and move on to the next value and leave the others blank. This means
I have to look around for something that appears only twice on one
account. Is there no way to make it put down on every row how many
times it appears in total using the matching of columns A B C and say
D if you are going to have to rewrite it then I can filter down and
see whats missing,

Please let me know if you need more information,

Thanks so much

Andrea
 
P

paul.robinson

Hi
Just put the new line before the end of the RowCount loop
....
'***********New line******
Cells(RowCount, "F").Value = TimesFound
Next RowCount

regards
Paul
 
A

amorrison2006

Hi Roger,

Your macro is debugging on my data at this part,

If TimesFound = 3 Then
Cells(Left(rowsfound, 1), 6) = "x"
Cells(Mid(rowsfound, 3, 1), 6) = "x"

Can you help correct it?

Thanks

Andrea
 
A

amorrison2006

Oh and roger with regards to your macro,

thanks for this,

the only problem might be that the same transaction could be in the
system twice therefore i'd want to see it six times hence I just want
to see how many times they appear just so i can filter down.

i hope im being clear and confusing you,

thanks

andrea
 
P

paul.robinson

Hi
It worked OK on my test data. You only want the

Cells(RowCount, "F").Value = TimesFound

line, not another "Next rowCount" line too?
regards
Paul
 
R

Roger Govier

Hi Andrea
i hope im being clear and confusing you,
Click to expand...
Not<bg>

I don't know why it is stopping there, it runs through fine for me.

Anyway, the second amendment that Paul posted is much nicer, and far
more efficient.
In another post, you said that was missing a Next without For. It works
fine for me, but in case you have deleted a row by mistake, I am posting
the revised code, with the Messagebox stripped out.

I have added one line near the start to clear column F of all data
before beginning. If you have filtered out and extracted the rows you
want, this just removes the count from the remaining rows before
starting again. Remove it if you don't want it.

Sub findtriples()
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Columns("F:F").EntireColumn.Clear
For RowCount = 1 To Lastrow
'Make sure data didn't appear earlier
Found = False
For OldRowCount = 1 To (RowCount - 1)
If Cells(RowCount, "A") = Cells(OldRowCount, "A") And _
Cells(RowCount, "B") = Cells(OldRowCount, "B") And _
Cells(RowCount, "C") = Cells(OldRowCount, "C") Then

Found = True
Exit For
End If
Next OldRowCount

If Found = False Then
'Count number of times combination is found
TimesFound = 1
rowsfound = CStr(RowCount)
For NewRowCount = (RowCount + 1) To Lastrow

If Cells(RowCount, "A") = Cells(NewRowCount, "A") And _
Cells(RowCount, "B") = Cells(NewRowCount, "B") And _
Cells(RowCount, "C") = Cells(NewRowCount, "C") Then

TimesFound = TimesFound + 1
rowsfound = rowsfound & "," & CStr(NewRowCount)
End If
Next NewRowCount
End If
Cells(RowCount, "F").Value = TimesFound

Next RowCount

End Sub
 
A

amorrison2006

Hi Paul

I read your post incorrectly. I have managed to put it in the right
place now and it does everything except when it gets to the next
occurence it will then say it only found 2 when the previous occurence
says its found 3.

Does this make sense?

Can this please be corrected.....I'm so silly with these things,

Thanks so much

Andrea
 
P

paul.robinson

Hi
Sorry about that, my test data didn't pick it up. This one works!

Sub findtriples()


Lastrow = Cells(Rows.Count, "A").End(xlUp).Row


For RowCount = 1 To Lastrow


'Make sure data didn't appear earlier
Found = False
For OldRowCount = 1 To (RowCount - 1)
If Cells(RowCount, "A") = Cells(OldRowCount, "A") And _
Cells(RowCount, "B") = Cells(OldRowCount, "B") And _
Cells(RowCount, "C") = Cells(OldRowCount, "C") Then
Found = True
'new line here to pick up exisiting count
Cells(RowCount, "F").Value = Cells(OldRowCount, "F")
Exit For
End If
Next OldRowCount


If Found = False Then
'Count number of times combination is found
TimesFound = 1
RowsFound = CStr(RowCount)
For NewRowCount = (RowCount + 1) To Lastrow


If Cells(RowCount, "A") = Cells(NewRowCount, "A") And _
Cells(RowCount, "B") = Cells(NewRowCount, "B") And _
Cells(RowCount, "C") = Cells(NewRowCount, "C") Then


TimesFound = TimesFound + 1
RowsFound = RowsFound & "," & CStr(NewRowCount)
End If
'***********New line to pick up new counts******
Cells(RowCount, "F").Value = TimesFound
Next NewRowCount

ABCData = CStr(Cells(RowCount, "A")) & ", " & _
CStr(Cells(RowCount, "B")) & ", " & _
CStr(Cells(RowCount, "C"))
MsgBox ("Row " & CStr(RowCount) & _
" data was found " & CStr(TimesFound) & _
" time(s)" & Chr(10) & _
"Data = " & ABCData & Chr(10) & _
"Row(s) = " & RowsFound)
End If
Next RowCount
End Sub

regards
Paul
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

copy data in turqouise colour cells from n to a 2
Help! Can’t debug macro used to delete duplicate rows 2
how to: c.value = "a cell value" 5
Checking for a minimum of 5 rows 2
Coloring Rows based on contents of cell A on each row 7
Modify existing code to dynamic code 5
Matching Rows 2nd try 2
How to copy and paste a partial row (i.e. not the EntireRow) 5

Top