Wrox Programmer Forums

Need to download code?

View our list of code downloads.

Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
Password Reminder
Register
| FAQ | Members List | Calendar | Search | Today's Posts | Mark Forums Read
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of tens of thousands of software programmers and website developers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining today you can post your own programming questions, respond to other developers’ questions, and eliminate the ads that are displayed to guests. Registration is fast, simple and absolutely free .
DRM-free e-books 300x50
Reply
 
Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old June 22nd, 2007, 07:14 AM
Registered User
 
Join Date: Jun 2007
Location: , , .
Posts: 3
Thanks: 0
Thanked 0 Times in 0 Posts
Default Comparing two excel sheets

Hi All,

I am a new at VBA programming and I have a task at hand. I need to compare two excel sheets and get that record into another sheet.

eg: "Sheet1" and "Sheet2" are two sheets, compare "sheet1's" data in "Sheet2". If the data is not found then paste the entire row into new sheet say "Sheet3". Then we do search from Sheet2 into "sheet1". Copy the entire row into another new sheet say "Sheet4". Can someone help me with this....I would really grateful. Right now this process takes me almost 2-weeks to complete since there are so many records.

Thank You.....


Reply With Quote
  #2 (permalink)  
Old July 3rd, 2007, 12:28 PM
Friend of Wrox
Points: 513, Level: 8
Points: 513, Level: 8 Points: 513, Level: 8 Points: 513, Level: 8
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Feb 2007
Location: Davenport, IA, USA.
Posts: 163
Thanks: 0
Thanked 2 Times in 2 Posts
Default

Checking for entire row being the same or just one or more cell(s)?

If you're checking 1 key cell, Column A for instance, try this:
------------------------------------------------------------------
Private Sub CommandButton1_Click()

'Grabs entire row and copies to corresponding sheet if not found on both worksheets.
'Assumes column A is the value checked and is already sorted ascending with no blank cells.
  Dim wsSheet1 As Worksheet, wsSheet2 As Worksheet, wsSheet3 As Worksheet, wsSheet4 As Worksheet
  Dim iSheet1Row As Long, iSheet2Row As Long, iSheet3Row As Long, iSheet4Row As Long

  Set wsSheet1 = ActiveWorkbook.Worksheets("Sheet1")
  Set wsSheet2 = ActiveWorkbook.Worksheets("Sheet2")
  Set wsSheet3 = ActiveWorkbook.Worksheets("Sheet3")
  Set wsSheet4 = ActiveWorkbook.Worksheets("Sheet4")
'below Assumes data rows start at 2, leaving heading row alone
  iSheet1Row = 2
  iSheet2Row = 2
  iSheet3Row = 2
  iSheet4Row = 2
  Do While wsSheet1.Cells(iSheet1Row, 1).Value <> "" And wsSheet2.Cells(iSheet2Row, 1).Value <> ""
    If wsSheet1.Cells(iSheet1Row, 1).Value = wsSheet2.Cells(iSheet2Row, 1).Value Then
      iSheet1Row = iSheet1Row + 1
      iSheet2Row = iSheet2Row + 1
    End If
    If wsSheet1.Cells(iSheet1Row, 1).Value < wsSheet2.Cells(iSheet2Row, 1).Value Then
      wsSheet1.Rows(iSheet1Row).Copy Destination:=wsSheet3.Cells(iSheet3Row, 1)
      iSheet1Row = iSheet1Row + 1
      iSheet3Row = iSheet3Row + 1
    End If
    If wsSheet1.Cells(iSheet1Row, 1).Value > wsSheet2.Cells(iSheet2Row, 1).Value Then
      wsSheet2.Rows(iSheet2Row).Copy Destination:=wsSheet4.Cells(iSheet4Row, 1)
      iSheet2Row = iSheet2Row + 1
      iSheet4Row = iSheet4Row + 1
    End If
  Loop
  If wsSheet1.Cells(iSheet1Row, 1).Value <> "" Then
    wsSheet1.Activate
    wsSheet1.Range(iSheet1Row & ":" & iSheet1Row).Select
    wsSheet1.Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy Destination:=wsSheet3.Cells(iSheet4Row, 1)
  End If
  If wsSheet2.Cells(iSheet2Row, 1).Value <> "" Then
    wsSheet2.Activate
    wsSheet2.Range(iSheet2Row & ":" & iSheet2Row).Select
    wsSheet2.Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy Destination:=wsSheet4.Cells(iSheet4Row, 1)
    wsSheet2.Cells(1, 1).Select
  End If
  wsSheet1.Activate
  wsSheet1.Cells(1, 1).Select

End Sub
------------------------------------------------------------------

If you are checking more than 1 cell or the entire row you'll need to modify the code above to accomodate.

Hope this helps.

Reply With Quote
  #3 (permalink)  
Old July 5th, 2007, 01:58 AM
Registered User
 
Join Date: Jun 2007
Location: , , .
Posts: 3
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Hey Allenm,

Thank you very much for the code, i have checked it and it works wonderful.

Thanks alot....

Reply With Quote
  #4 (permalink)  
Old July 5th, 2007, 02:00 AM
Registered User
 
Join Date: Jun 2007
Location: , , .
Posts: 3
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Allenm, i also did write this code, its kinda long and not as clean as you have writen. can you have a look and let me know of any pitfalls that i might have in the code..

Sub GainsLossesMacro()
'
' Mine Macro
' Macro recorded 6/22/2007 by singau
'

'
    Dim rwctr1, rwctr2, g_rwctr, l_rwctr, colctr1, colctr2 As Integer
    Dim t1, t2 As String

    'Sort the Current Quarter Sheet with the Invest 1 ID
    Worksheets("Current Quarter").Select
    Range("A1:Z60000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

    'Sort the Previous Quarter Sheet with the Invest 1 ID
    Worksheets("Previous Quarter").Select
    Range("A1:Z60000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

    'Clean up the Gains Sheet
    Worksheets("Gains").Activate
    Cells.Select
    Selection.ClearContents
    Selection.Interior.ColorIndex = xlNone
    Range("A1").Select

    'Clean up the Loss Sheet
    Worksheets("Losses").Activate
    Cells.Select
    Selection.ClearContents
    Selection.Interior.ColorIndex = xlNone
    Range("A1").Select

    Worksheets("Current Quarter").Select

    'setting counters
    colctr1 = 1
    colctr2 = 1
    rwctr2 = 2
    g_rwctr = 2
    rwctr1 = 2

    'Pasting the headers
    Worksheets("Current Quarter").Rows(1).Copy
    Worksheets("Gains").Activate
    Worksheets("Gains").Rows(1).Select
    ActiveSheet.Paste
    Worksheets("Current Quarter").Rows(1).Copy
    Worksheets("Losses").Activate
    Worksheets("Losses").Rows(1).Select
    ActiveSheet.Paste
'------------------------------------GAINS CALCULATIONS------------------------------------
    For rwctr1 = 2 To 1000
        t1 = Worksheets("Current Quarter").Cells(rwctr1, colctr1)
        t2 = Worksheets("Previous Quarter").Cells(rwctr2, colctr2)
        For rwctr2 = 2 To 1000
            t2 = Worksheets("Previous Quarter").Cells(rwctr2, colctr1)
            If t1 = t2 Then
                'rwctr2 = rwctr2 + 1
            Else
                Worksheets("Current Quarter").Rows(rwctr1).Copy
                Worksheets("Gains").Activate
                Worksheets("Gains").Rows(g_rwctr).Select
                ActiveSheet.Paste
                g_rwctr = g_rwctr + 1
            End If
            rwctr1 = rwctr1 + 1
            t1 = Worksheets("Current Quarter").Cells(rwctr1, colctr1)
        Next rwctr2
    Next rwctr1

' MsgBox "Phew! Done Finally"
' MsgBox "Automation by Gauravdeep Singh Sethi"
' Worksheets("Losses").Activate
' Range("A1").Select
    Worksheets("Gains").Activate
    Range("A1").Select
' Worksheets("Gains").Cells("A2").FreezePanes = True
'------------------------------------END GAINS CALCULATIONS------------------------------------

MsgBox "Gains Caluclations are done. Do you want to continue?", vbYesNo
l_rwctr = 2

'------------------------------------LOSSES CALCULATIONS---------------------------------------
    For rwctr2 = 2 To 1000
        t2 = Worksheets("Current Quarter").Cells(rwctr2, colctr2)
        t1 = Worksheets("Previous Quarter").Cells(rwctr1, colctr1)
        For rwctr1 = 2 To 1000
            t1 = Worksheets("Current Quarter").Cells(rwctr2, colctr2)
            If t1 = t2 Then
                'rwctr2 = rwctr2 + 1
            Else
                Worksheets("Previous Quarter").Rows(rwctr1).Copy
                Worksheets("Losses").Activate
                Worksheets("Losses").Rows(l_rwctr).Select
                ActiveSheet.Paste
                l_rwctr = l_rwctr + 1
            End If
            rwctr2 = rwctr2 + 1
            t2 = Worksheets("Current Quarter").Cells(rwctr2, colctr2)
        Next rwctr1
    Next rwctr2

' MsgBox "Phew! Done Finally"
' MsgBox "Automation by Gauravdeep Singh Sethi"
    Worksheets("Losses").Activate
    Range("A1").Select
' Worksheets("Gains").Cells("A2").FreezePanes = True
' Worksheets("Gains").Activate
' Range("A1").Select


'------------------------------------END LOSSES CALCULATIONS---------------------------------------
    MsgBox "Phew! Done Finally"
    'MsgBox "Automation by Gauravdeep Singh Sethi"
End Sub

Reply With Quote
  #5 (permalink)  
Old July 6th, 2007, 03:15 PM
Friend of Wrox
Points: 513, Level: 8
Points: 513, Level: 8 Points: 513, Level: 8 Points: 513, Level: 8
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Feb 2007
Location: Davenport, IA, USA.
Posts: 163
Thanks: 0
Thanked 2 Times in 2 Posts
Default

It should work as long as you are going to have 1000 rows with data and no more. The only issue is minor as you're going through the data twice (with 2 loops). It seems like you should be able to adjust your logic so you only need to go through it once. Try modifying it so that you only have to loop through the sheets once and the code should be faster. Otherwise it should be good to go, as long as the outcome is what you're looking for.

As for what it does to your data compared to what you want is something I can't tell you without knowing exactly what the desired outcome is from sample input.

As for coding... your code is different enough that it's apparent you're adapting commands into your own logic which is better than just copying verbatim. AND you are documenting it. The rest comes with experience and practice and command knowledge.

Reply With Quote
  #6 (permalink)  
Old August 28th, 2009, 05:20 PM
Registered User
 
Join Date: Aug 2009
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Allenm, this is a great macro. however, what if I wanted to compare 20 columns and any changes in either sheet1 or sheet 2 should be moved to sheet 3 and sheet 4. could you help with that please?
Reply With Quote
Reply


Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Trackbacks are Off
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Working with excel sheets ramsri VB How-To 1 October 25th, 2007 03:15 PM
Import From excel with n sheets dbellavi SQL Server DTS 1 September 11th, 2007 07:51 AM
Exporting Table to Excel Sheets ayazhoda Access VBA 11 April 5th, 2007 07:25 AM
How to read values from excel sheets gurusamy.senthil Beginning VB 6 0 May 8th, 2006 07:11 AM
MX2004 Can't Import Excel Sheets koolkat67 Dreamweaver (all versions) 0 February 17th, 2006 06:00 PM



All times are GMT -4. The time now is 12:40 AM.


Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
© 2013 John Wiley & Sons, Inc.