Help needed with Macro designed to compare data...

M

Monomeeth

Hello All

Some time ago I worked on a macro to compare data on one worksheet with that
in two other worksheets.

This macro was designed to check whether any records located in the
“Filtered Data†worksheet already exist in either the “Outstanding†or
“Complete†worksheets. This was done by comparing a unique identifier (i.e.
the “AGS Number†in Column A).

If the record doesn’t already exist, then a copy of the record is placed in
the “Additions†worksheet.

If the record already exists in the “Outstanding†worksheet, then a
comparison of the “end date†field is made. If the end date is different, a
copy of the record is placed in the “Changes†worksheet. If it isn’t
different, then a copy is placed in the “Ignored†worksheet.

Likewise, if the record already exists in the “Complete†worksheet, then a
copy of it is placed in the “Ignored†worksheet.

The same record cannot appear in both the “Outstanding†and “Completeâ€
worksheets.

In theory, then, by adding the total number of records located in the
“Ignoredâ€, “Additions†and “Changes†worksheets, we should get the same
number of records located in the “Filtered Data†worksheet.

This isn’t happening and that’s why I need your help! The following code was
written about six months ago with the help of other people and now I’m at a
bit of a loss to find where the problem is:



Sub CompareData()

Sheets("Ignored").Select
Columns("A:Z").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Sheets("Additions").Select
Columns("A:Z").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Sheets("Changes").Select
Columns("A:Z").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select

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



If it helps, below are the headings associated with each column:

A AGS Number
B First Name
C Last Name
D User ID
E BSL
F Location
G Acting Grade
H Base Grade
I Reason
J Start Date
K End Date


I hope this makes sense…

Thanks for your help!

Joe.
 
J

Joel

No. If the dates are not matched then nothing happens. I modified code
below to added additional items into the ignore sheet so you get the correct
count

Sub CompareData()

Sheets("Ignored").Columns("A:Z").Delete
Sheets("Additions").Columns("A:Z").Delete
Sheets("Changes").Columns("A:Z").Delete

FilteredRowCount = 1
OutstandingRowCount = 1
ChangesRowCount = 1
IgnoredRowCount = 1

With Sheets("Filtered Data")

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

Ignore = False
SearchItem = .Range("A" & FilteredRowCount)

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(FilteredRowCount).Copy _
Destination:=Sheets("Additions").Rows(OutstandingRowCount)
OutstandingRowCount = OutstandingRowCount + 1
Else
'compare end dates

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

If CDate(.Range("K" & FilteredRowCount)) > _
CDate(c.Offset(0, 10)) Then

.Rows(FilteredRowCount).Copy _
Destination:=Sheets("Changes").Rows(ChangesRowCount)
ChangesRowCount = ChangesRowCount + 1

else
Ignore = True
End If
else
Ignore = true
End If
End If

Else
ignore = true
End If

if ignore = true then
.Rows(FilteredRowCount).Copy _
Destination:=Sheets("Ignored").Rows(IgnoredRowCount)
IgnoredRowCount = IgnoredRowCount + 1
end if
FilteredRowCount = FilteredRowCount + 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

Top