Help with macro comparing data in worksheets

M

Monomeeth

Hi All

I have just discovered that a Macro I worked on a couple of weeks back has
some sort of bug in it, and now I need your help to find it!

DESCRIPTION
The macro is designed to compare data between a number of worksheets within
the same workbook. Specifically, it is supposed to do the following:

1. First, it compares a worksheet called "Filtered Data" with a worksheet
called "Complete", using the first column "AGS" as the point of reference.
AGS is an 8 digit number which is a unique identifier. If the same AGS is
found on both sheets, then the Macro ignores this row in the "Filtered Data"
worksheet and puts a copy of this row in another worksheet called "Ignored".
2. If the AGS is not found in the "Complete" worksheet, then the Macro
next checks to see if the AGS appears on a worksheet called "Oustanding". If
the AGS is not found on this worksheet, then the Macro makes a copy of this
row from the "Filtered Data" worksheet and places it into a worksheet called
"Additions".
3. If, on the other hand, the AGS is found in the "Outstanding" worksheet,
the Macro then checks a second column called "End Date". If the "End Date" in
the "Filtered Data" worksheet is different to that in the "Outstanding"
worksheet, then the Macro makes a copy of this row into another worksheet
called "Changes".

Up until now I thought this was all working okay, but now I realised that
something is not quite right. Because the "Filtered Data" worksheet is the
one being compared with the other worksheets, this should mean the number of
entries being copied into the "Ignored", "Additions" and "Changes" worksheets
should add up to the same number of rows in the "Filtered Data" worksheet.
But when I checked the last time this Macro was run, these three added
together had 44 fewer records.

I then did a manual comparison to identify the 44 "missing" records and
found that they were all records which should have been ignored and listed in
the "Ignored" worksheet. As far as I can tell, the data IS being ignored,
but just not copied into the "Ignored" worksheet, which I need to happen in
case the process ever gets audited.

I hope this all makes sense.

The Macro code is below:


Sub CompareData()

Sh1RowCount = 1
Sh3RowCount = 1
Sh4RowCount = 1
Sh5RowCount = 1
With Sheets("Filtered Data")

Do While .Range("A" & Sh1RowCount) <> ""

SearchItem = .Range("A" & Sh1RowCount)

With Sheets("Complete")
Set c = .Columns("A:A").Find(What:=SearchItem, _
LookIn:=xlValues)
End With

If c Is Nothing Then

With Sheets("Outstanding")
Set c = .Columns("A:A").Find(What:=SearchItem, _
LookIn:=xlValues)
End With

If c Is Nothing Then
.Rows(Sh1RowCount).Copy _
Destination:=Sheets("Additions").Rows(Sh3RowCount)
Sh3RowCount = Sh3RowCount + 1
Else
'compare end dates

If IsDate(.Range("K" & Sh1RowCount)) = True And
IsDate(c.Offset(0, 10)) = True Then
If CDate(.Range("K" & Sh1RowCount)) > _
CDate(c.Offset(0, 10)) Then

.Rows(Sh1RowCount).Copy _
Destination:=Sheets("Changes").Rows(Sh4RowCount)
Sh4RowCount = Sh4RowCount + 1

End If
End If

End If

Else
.Rows(Sh1RowCount).Copy _
Destination:=Sheets("Ignored").Rows(Sh5RowCount)
Sh5RowCount = Sh5RowCount + 1

End If

Sh1RowCount = Sh1RowCount + 1
Loop

End With

MsgBox ("New data has been successfully compared to existing data.")

End Sub
 
N

Nigel

The sheet row counters are all set to one at the outset, it appears that
this results in copy destinations over writing existing entries?

--

Regards,
Nigel
(e-mail address removed)
 
J

Joel

I recognized my coding style. Noticed you made some changes. I carefully
read your latest posting and below is my intepretation of your new
requirements. I change the date comparison to <> becuase you said not equal.
Also made changes to variable names to make the code easier to follow. I
added "LOOKAT" to make sure it is looking at the full data word.


Sub CompareData()

FiltRowCount = 1
OutRowCount = 1
ChangeRowCount = 1
AdditRowCount = 1
With Sheets("Filtered Data")

Do While .Range("A" & FiltRowCount) <> ""

SearchItem = .Range("A" & FiltRowCount)

With Sheets("Complete")
Set In_Complete = .Columns("A:A").Find(What:=SearchItem, _
LookIn:=xlValues,lookat:=xlwhole)
End With

If In_Complete Is Nothing Then

.Rows(FiltRowCount).Copy _
Destination:=Sheets("Ignored"). _
Rows(FiltRowCount)
FiltRowCount = FiltRowCount + 1
Else

With Sheets("Outstanding")
Set In_Outstanding = .Columns("A:A").Find(What:=SearchItem, _
LookIn:=xlValues,lookat:=xlwhole)
End With

If In_Outstanding Is Nothing Then
.Rows(FiltRowCount).Copy _
Destination:=Sheets("Additions"). _
Rows(AddRowCount)
AdditRowCount = AdditRowCount + 1
Else
'compare end dates

If IsDate(.Range("K" & FiltRowCount)) = True And _
IsDate(C.Offset(0, 10)) = True Then

If CDate(.Range("K" & Sh1RowCount)) <> _
CDate(C.Offset(0, 10)) Then

.Rows(FiltRowCount).Copy _
Destination:=Sheets("Changes"). _
Rows(ChangeRowCount)
ChangeRowCount = ChangeRowCount + 1

End If

End If
End If
End If
End If

FiltRowCount = FiltRowCount + 1
Loop

End With

MsgBox ("New data has been successfully compared to existing data.")

End Sub
 
M

Monomeeth

Hi Joel

Thanks for your help.

I replaced the code with your edited code, but now get a Compile error.

The debugger highlights the very last End If statement with a message
stating "End If without block If".

I'm obviously very tired - can't seem to resolve it.

:(

Joe.
 
J

Joel

I didn't test the code, but fixed the compiler error. Your original
description of the problem (previous posting) and this posting werre diferent
so I'm not sure if the code does exacttly what you want. Both are very
similar and can easily be changed if there is a problem.

Sub CompareData()

FiltRowCount = 1
OutRowCount = 1
ChangeRowCount = 1
AdditRowCount = 1
With Sheets("Filtered Data")

Do While .Range("A" & FiltRowCount) <> ""

SearchItem = .Range("A" & FiltRowCount)

With Sheets("Complete")
Set In_Complete = .Columns("A:A").Find(What:=SearchItem, _
LookIn:=xlValues, lookat:=xlWhole)
End With

If In_Complete Is Nothing Then

.Rows(FiltRowCount).Copy _
Destination:=Sheets("Ignored"). _
Rows(FiltRowCount)
FiltRowCount = FiltRowCount + 1
Else

With Sheets("Outstanding")
Set In_Outstanding = .Columns("A:A").Find(What:=SearchItem, _
LookIn:=xlValues, lookat:=xlWhole)
End With

If In_Outstanding Is Nothing Then
.Rows(FiltRowCount).Copy _
Destination:=Sheets("Additions"). _
Rows(AddRowCount)
AdditRowCount = AdditRowCount + 1
Else
'compare end dates

If IsDate(.Range("K" & FiltRowCount)) = True And _
IsDate(C.Offset(0, 10)) = True Then

If CDate(.Range("K" & Sh1RowCount)) <> _
CDate(C.Offset(0, 10)) Then

.Rows(FiltRowCount).Copy _
Destination:=Sheets("Changes"). _
Rows(ChangeRowCount)
ChangeRowCount = ChangeRowCount + 1

End If

End If
End If
End If

FiltRowCount = FiltRowCount + 1
Loop

End With

MsgBox ("New data has been successfully compared to existing data.")

End Sub
 

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

Help needed with Macro designed to compare data... 2
Run time error 5
Streamlining my code 1
VBA Coding Help for Beginner 0
I need help with a macro to compare data between worksheets 0
Little help with "Number stored as Text" 1
Sort and Extract Macro 1
Datewise table view with unique count 1

Top