Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
|
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 software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old June 22nd, 2007, 07:14 AM
Registered User
 
Join Date: Jun 2007
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.....


 
Old July 3rd, 2007, 12:28 PM
Friend of Wrox
 
Join Date: Feb 2007
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.

 
Old July 5th, 2007, 01:58 AM
Registered User
 
Join Date: Jun 2007
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....

 
Old July 5th, 2007, 02:00 AM
Registered User
 
Join Date: Jun 2007
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

 
Old July 6th, 2007, 03:15 PM
Friend of Wrox
 
Join Date: Feb 2007
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.

 
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?





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





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