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 / New Users / November 2007

Tip: Looking for answers? Try searching our database.

Using Macros to compare data?

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
Joe - 02 Nov 2007 10:50 GMT
Hello

I would like to know whether it is possible to do something with the use of
a macro.

Could a macro be recorded (or written) that compares the data from a single
worksheet in one spreadsheet with the data in two worksheets on another
spreadsheet?

EXAMPLE
Let's assume all worksheets have the same column headings. One of these is
an End Date field, and another of these is a User ID field.  What I want is
to compare the data in the first main spreadsheet with that in the second
spreadsheet so that if a row of data has the same User ID and if the End
Date recorded in the main spreadsheet is later than that recorded in one of
the other two worksheets on the second spreadsheet, then that data is copied
across to the second spreadsheet.

Basically, it takes us about three hours every week to go through and do
this manually, and I am thinking there has got to be a better way.

Any advice or suggestions would be most appreciated.

Thanks,

Joe.
JLatham - 04 Nov 2007 19:11 GMT
Joe,
I think this will work for you.  Make copies of your workbooks and test it
with them before committing things to your actual working copies.

Open up the 'master' workbook and press [Alt]+[F11] to enter the VB Editor.  
In it, choose Insert and Module from the menu.  Copy the code below and paste
it into the module presented to you.  Then change the assigned values of the
Const values to match the names of the workbook, worksheets and columns
involved in your workbooks.

While still in the VB Editor use Debug and Compile Project from the menu and
make sure it compiles without error.  If it does not, it probably means that
one of the lines of code got broken by posting it here.  The error line will
be highlighted in yellow and if it doesn't end with a " _" it probably got
broken and you need to edit it so that the line below becomes part of the
indicated error line.

When it compiles without error, close the VB Editor, save the workbook, then
open the 'destination' book (the one with the 2 worksheets in it) and then
use Tools | Macro | Macros to run the macro.  With a bit of luck, it should
work to completion properly for you.

Sub CompareAndUpdate()
 'both workbooks must be open before
 'running this macro
 
 'change these Const values as required
 Const src1stDataRow = 2 ' first row in this wb with data
 Const dest1stDataRow = 2 ' first row in other sheets w/data
 Const ID_Col = "A"
 Const EndDate_Col = "B"
 Const firstCol = "A" ' first column with data to compare
 Const lastCol = "R" ' last column w/data to compare
 'next is name of sheet in THIS workbook with
 'master data on it
 Const masterSheetName = "Sheet2"
 'next is name of the other workbook
 Const wb2Name = "OtherWorkbook.xls"
 'thest are names of the two sheets in
 'the other workbook to examine/update
 Const wb2S1Name = "Sheet1"
 Const wb2S2Name = "Sheet2"
'end of user definable Const values

 Dim wb1ws As Worksheet ' source data sheet in this workbook
 Dim srcLastRow As Long
 Dim srcIDCell As Range
 Dim srcDateCell As Range
 Dim srcRange As Range
 Dim srcRowPtr As Long
 
 Dim wb2 As Workbook ' will 'be' other workbook
 Dim wb2ws As Worksheet ' will be other worksheet(s)
 Dim destLastRow As Long
 Dim destIDCell As Range
 Dim destDateCell As Range
 Dim destRange As Range
 Dim destRowPtr As Long
 
 On Error Resume Next
 Set wb2 = Workbooks(wb2Name)
 If Err <> 0 Then
   Err.Clear
   MsgBox "You must also open workbook " & wb2Name & _
    " before performing this operation.", vbOKOnly, _
    "Workbook Unavailable"
   On Error GoTo 0
   Exit Sub
 End If
 On Error GoTo 0
 
 Set wb1ws = ThisWorkbook.Worksheets(masterSheetName)
 'use Rows.CountLarge if using Excel 2007
 srcLastRow = wb1ws.Range(ID_Col & Rows.Count).End(xlUp).Row
 
 'set up to test first destination sheet in other book
 Set wb2ws = wb2.Worksheets(wb2S1Name)
 'again, use Rows.CountLarge if using Excel 2007
 destLastRow = wb2ws.Range(ID_Col & Rows.Count).End(xlUp).Row
 For srcRowPtr = src1stDataRow To srcLastRow
   Set srcIDCell = wb1ws.Range(ID_Col & srcRowPtr)
   Set srcDateCell = wb1ws.Range(EndDate_Col & srcRowPtr)
   For destRowPtr = dest1stDataRow To destLastRow
     Set destIDCell = wb2ws.Range(ID_Col & destRowPtr)
     Set destDateCell = wb2ws.Range(EndDate_Col & destRowPtr)
     'first, check if IDs match
     If srcIDCell = destIDCell Then
       'IDs match, check dates
       If srcDateCell > destDateCell Then
         'have to update this row's data
         Set srcRange = wb1ws.Range(firstCol & srcRowPtr & _
          ":" & lastCol & srcRowPtr)
         Set destRange = wb2ws.Range(firstCol & destRowPtr & _
          ":" & lastCol & destRowPtr)
         'update the values
         destRange.Value = srcRange.Value
       End If ' date test
     End If ' ID match test
   Next ' end of dest sheet testing
 Next ' end of source sheet testing
   
 'set up to test first destination sheet in other book
 Set wb2ws = wb2.Worksheets(wb2S2Name)
 'again, use Rows.CountLarge if using Excel 2007
 destLastRow = wb2ws.Range(ID_Col & Rows.Count).End(xlUp).Row
 For srcRowPtr = src1stDataRow To srcLastRow
   Set srcIDCell = wb1ws.Range(ID_Col & srcRowPtr)
   Set srcDateCell = wb1ws.Range(EndDate_Col & srcRowPtr)
   For destRowPtr = dest1stDataRow To destLastRow
     Set destIDCell = wb2ws.Range(ID_Col & destRowPtr)
     Set destDateCell = wb2ws.Range(EndDate_Col & destRowPtr)
     'first, check if IDs match
     If srcIDCell = destIDCell Then
       'IDs match, check dates
       If srcDateCell > destDateCell Then
         'have to update this row's data
         Set srcRange = wb1ws.Range(firstCol & srcRowPtr & _
          ":" & lastCol & srcRowPtr)
         Set destRange = wb2ws.Range(firstCol & destRowPtr & _
          ":" & lastCol & destRowPtr)
         'update the values
         destRange.Value = srcRange.Value
       End If ' date test
     End If ' ID match test
   Next ' end of dest sheet testing
 Next ' end of source sheet testing
'release used resources
 Set srcIDCell = Nothing
 Set srcDateCell = Nothing
 Set destIDCell = Nothing
 Set destDateCell = Nothing
 Set srcRange = Nothing
 Set destRange = Nothing
 Set wb1ws = Nothing
 Set wb2ws = Nothing
 Set wb2 = Nothing
End Sub

> Hello
>
[quoted text clipped - 22 lines]
>
> Joe.

Rate this thread:






 
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.