Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / Programming / January 2008

Tip: Looking for answers? Try searching our database.

Help with macro comparing data in worksheets

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
Monomeeth - 23 Jan 2008 22:13 GMT
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
Nigel - 24 Jan 2008 04:12 GMT
The sheet row counters are all set to one at the outset, it appears that
this results in copy destinations over writing existing entries?

Signature

Regards,
Nigel
nigelnospam@9sw.co.uk

> Hi All
>
[quoted text clipped - 112 lines]
>
> End Sub
Joel - 24 Jan 2008 11:45 GMT
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

> Hi All
>
[quoted text clipped - 99 lines]
>
> End Sub
Monomeeth - 31 Jan 2008 04:37 GMT
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.

> I recognized my coding style.  Noticed you made some changes.  I carefully
> read your latest posting and below is my intepretation of your new
[quoted text clipped - 170 lines]
> >
> > End Sub
Joel - 31 Jan 2008 11:31 GMT
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

> Hi Joel
>
[quoted text clipped - 185 lines]
> > >
> > > End Sub
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.