Results 1 to 14 of 14
  1. #1
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839

    Excel work book comparison

    I an gleaned this off the internet and modified it a little. This is a start, but I want to be able to select the file(s) later, and I am running this in Access off an command button.

    I did an update after I found some coding changes see Orange text. I get a runtime error 429 Can't create object on the Bold red text. How do I go about makingg an excel and exporting the output to the new Excel file?




    Code:
    Public Sub comparetest_Click()
        Dim varSheetA As Variant
        Dim varSheetB As Variant
        Dim strRangeToCheck As String
        Dim iRow As Long
        Dim iCol As Long
        Dim NRow As Long
        Dim NCol As Long
        Dim xlApp As Excel.Application
        Dim WkBkA As Excel.Workbook
        Dim WkBkB As Excel.Workbook
        Dim WkBkC As Excel.Workbook
        strRangeToCheck = "A1:I137"  
        NRow = 1
        NCol = 1
    Set WkBkA = Workbooks.Open("C:\Temp\BalanceSheet.xlsx")
    Set varSheetA = WkBkA.Worksheets("Data").Range(strRangeToCheck)   
    Set WkBkB = Workbooks.Open(FileName:="C:\Temp\BalanceSheet_old.xlsx")
    Set varSheetB = WkBkB.Worksheets("Data").Range(strRangeToCheck)
    Set xlApp = CreateObject("Excel.Applpication")
        With xlApp
            Set WkBkC = Workbooks.Add("C:\Temp\Comaprison.xls")
        End With
    
        varSheetA = Worksheets("Sheet1").Range(strRangeToCheck)
        varSheetB = Worksheets("Sheet2").Range(strRangeToCheck)
    
        For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
            For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
                If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
                Else                                                            
                        
                Cells(NRow, NCol) = varSheetA(iRow, 2)                        
                Cells(NRow, NCol + 1) = varSheetA(iRow, iCol)          
                Cells(NRow, NCol + 2) = varSheetB(iRow, iCol)     
                Cells(NRow, NCol + 3) = NRow                       
                Cells(NRow, NCol + 4) = NCol    
                NRow = NRow + 1
                End If
            Next iCol
        Next iRow
    End Sub

  2. #2
    ranman256's Avatar
    ranman256 is offline VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    9,521
    you set WkBkA as an application, not a workbook

    Code:
    dim xl as excel.application
    with xl
       .Workbooks.Open mvXLfile
       set wkBkA = .activeworkbook
    end with
    and remember , all excel objects must be connected to the app (with a period)
    xl.worksheets
    xl.workbooks

  3. #3
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    Thanks Ranman256,
    I tried
    Code:
     xlApp.Workbooks.Add ("C:\Temp\Comaprison.xlsx")
            Set WkBkC = .ActiveWorkbook
        End With
    I wanted the out put of WkBkC to be made in C:\Temp location as Comparison.xlsx

    I get a Runtime error 91 Object Variable or with block variable not set.

    On xlApp.Workbooks.Add ("C:\Temp\Comaprison.xls")

  4. #4
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    Using Access automation to control Excel is very tricky. I have code in Access that creates an Excel spreadsheet (xlsx), then opens the spreadsheet (hidden), does some formatting, then saves and closes. Too a long time to get it worked out.

    I modified your code to be able to open both spreadsheets, then close both and quit Excel. I have found the "DoEvents" command is necessary to fully exit from Excel.
    Not sure about your looping....
    Code:
    Option Compare Database  '<-should be at the top of every module
    Option Explicit                   '<-should be at the top of every module
    
    --------------------------------------------------------------------------
    
    Public Sub comparetest_Click()
    '
    ' REQUIRES a reference set to Microsoft Excel xx.0 Object Library
    ' for Access 2010, xx = 14
    '
        Dim xlx As Excel.Application
    
        Dim WkBkA As Excel.Workbook
        Dim WkBkB As Excel.Workbook
        Dim WkBkC As Excel.Workbook
    
        Dim wkSheetA As Excel.Worksheet
        Dim wkSheetB As Excel.Worksheet
        Dim wkSheetC As Excel.Worksheet
    
    
        Dim strRangeToCheck As String
    
        Dim iRow As Long
        Dim iCol As Long
        Dim NRow As Long
        Dim NCol As Long
    
        strRangeToCheck = "A1:I137"
        NRow = 1
        NCol = 1
    
    
        Set xlx = New Excel.Application
        xlx.Visible = True
    
        Set WkBkA = xlx.Workbooks.Open("C:\Temp\BalanceSheet.xlsx")
        Set wkSheetA = WkBkA.Worksheets("Data")
    
        Set WkBkB = xlx.Workbooks.Open("C:\Temp\BalanceSheet_old.xlsx")
        Set wkSheetB = WkBkB.Worksheets("Data")
    
        ' ==== this workbook needs to exist before executing the code ============
        Set WkBkC = xlx.Workbooks.Open("C:\Temp\Comparison.xlsx")
        Set wkSheetC = WkBkB.Worksheets(1)
    
        For iRow = 1 To 137
            For iCol = 1 To 9
                If wkSheetA(iRow, iCol) = wkSheetB(iRow, iCol) Then
                    'do nothing
                Else
                    '                Workbooks.Add ("C:\Temp\Comparison.xlsx")   '<<-- shouldn't add a new workbook every iteriation
                    wkSheetC.Cells(NRow, NCol) = wkSheetA(iRow, 2)
                    wkSheetC.Cells(NRow, NCol + 1) = wkSheetA(iRow, iCol)
                    wkSheetC.Cells(NRow, NCol + 2) = wkSheetB(iRow, iCol)
                    wkSheetC.Cells(NRow, NCol + 3) = NRow
                    wkSheetC.Cells(NRow, NCol + 4) = NCol
                    NRow = NRow + 1
                End If
            Next iCol
        Next iRow
    
    
        '--Clean up--
        WkBkC.Close SaveChanges:=True
        WkBkB.Close SaveChanges:=True
        WkBkA.Close SaveChanges:=True
    
        xlx.Quit   ' shut down Excel app
    
        DoEvents  'adds delay
    
        'now destroy the objects
        Set WkBkC = Nothing
        Set WkBkB = Nothing
        Set WkBkA = Nothing
    
        Set xlx = Nothing
    
    End Sub

    WARNING: I was not able to completely test this code. This is mostly Air code!!!

  5. #5
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    ssNafu,
    I ended up with an error 1004 Sorry, we couldn't find C:\Temp\Comparison.xlsx on:

    Set WkBkC = xlx.Workbooks.Open("C:\Temp\Comparison.xlsx")

    Otherwise it opens the 2 XLSX files.

    I don't know myself about the loop. It seems to work fine until I need to make a XLSX file and put the comparison data in.

  6. #6
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    Did you create the excel file? Is it in the correct location?

    Code:
     ' ==== this workbook needs to exist before executing the code ============
        Set WkBkC = xlx.Workbooks.Open("C:\Temp\Comparison.xlsx")
        Set wkSheetC = WkBkB.Worksheets(1)
    Ack!!! I just saw an error!!!

    In this line, the "B"
    Code:
    Set wkSheetC = WkBkB.Worksheets(1)
    should be a "C"
    Code:
    Set wkSheetC = WkBkC.Worksheets(1)

  7. #7
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    ssnafu,
    No I haven't. that was what I was looking for. How do I do that? I tried setting a variable as an object then createobject code.

  8. #8
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    It is just an Excel workbook.
    Open Excel, then do a SAVE AS and name it "Comparison.xlsx". Save it in the C:\Temp folder.


    BTW, it is ssanfu, not ssnafu

  9. #9
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    ssanfu,
    I did that as a test, and all open fine. I get an error on the "If wkSheetA(iRow, iCol) = wkSheetB(iRow, iCol) Then " on your code Mine I get the msgbox popup saying they are the same after the comparison. I added this to both code sets to see what happens, plus its crazy not to have some kind of indication.
    If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
    MsgBox "The files are the same"
    Else

    My apologies, dyslexic reading and assumptions. I gather you know the acronym SNAFU? I always wondered why you chose ssnafu, until the correction

  10. #10
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    As I said, I didn't test the looping. I tried to get the workbooks to open and close properly.
    If you code works properly, then you should use it. I would change 3 or 4 cells and ensure the code found the differences.

    My apologies, dyslexic reading and assumptions
    No problems.... happens frequently.

    And yes, I know the acronym.


    Good luck with your project.....

  11. #11
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    ssanfu,
    I got the comparison to work. I need some assistance with the else . If varSheetA(iRow, iCol) <> varSheetB(iRow, iCol) Then ' This does not seem to do anything no matter the status of the difference in worksheets if I enable this code:

    'Else
    'MsgBox "The files are the same"
    'Exit Sub

    The output is always the same, and I get the popup - "The files are the same"


    I added :
    Set WkBkC = Nothing
    Set WkBkB = Nothing
    Set WkBkA = Nothing
    Set xlApp = Nothing

    to the front to clean out any previous files while clearing errors and such.

    Code is:
    Code:
    Private Sub comparetest_Click()
        Dim varSheetA As Variant
        Dim varSheetB As Variant
        Dim strRangeToCheck As String
        Dim iRow As Long
        Dim iCol As Long
        Dim NRow As Long
        Dim NCol As Long
        Dim xlApp As Excel.Application
        Dim wkSheetA As Excel.Worksheet
        Dim wkSheetB As Excel.Worksheet
        Dim wkSheetC As Excel.Worksheet
        Dim WkBkA As Excel.Workbook
        Dim WkBkB As Excel.Workbook
        Dim WkBkC As Excel.Workbook
    Set WkBkC = Nothing
    Set WkBkB = Nothing
    Set WkBkA = Nothing
    Set xlApp = Nothing
        strRangeToCheck = "A1:I30" 
        NRow = 1
        NCol = 1
        Set xlApp = New Excel.Application
        xlApp.Visible = False
    Set WkBkA = Workbooks.Open("C:\Temp\BalanceSheet_New.xlsx")
    Set varSheetA = WkBkA.Worksheets(1).Range(strRangeToCheck) 
    Set WkBkB = Workbooks.Open("C:\Temp\BalanceSheet_old.xlsx") 
    Set varSheetB = WkBkB.Worksheets(1).Range(strRangeToCheck)
    xlApp.Visible = True
    Set WkBkC = Workbooks.Open("C:\Temp\Comparison.xlsx")
    Set wkSheetC = WkBkC.Worksheets(1)
    
        varSheetA = WkBkA.Worksheets(1).Range(strRangeToCheck)
        varSheetB = WkBkB.Worksheets(1).Range(strRangeToCheck)
    
    For iCols = 1 To 9
       wkSheetC.Cells(1, NCol) = varSheetA(1, iCols)
       NCol = NCol + 1
    Next iCols
    
         For iRow = 1 To 30
            For iCol = 1 To 9
                If varSheetA(iRow, iCol) <> varSheetB(iRow, iCol) Then  
    
                 wkSheetC.Cells(NRow, NCol + 1) = varSheetA(iRow, iCol) & "  ===>  " & varSheetB(iRow, iCol) 
    
                'Else
                'MsgBox "The files are the same"
                'Exit Sub
                End If
                 Next iCol
             Next iRow
    
    WkBkC.Close SaveChanges:=True
    WkBkB.Close SaveChanges:=False
    WkBkA.Close SaveChanges:=False
    
    Excel.Application.Quit
    
    DoEvents
    
    Set WkBkC = Nothing
    Set WkBkB = Nothing
    Set WkBkA = Nothing
    Set xlApp = Nothing
    
    End Sub

  12. #12
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    I added :
    Set WkBkC = Nothing
    Set WkBkB = Nothing
    Set WkBkA = Nothing
    Set xlApp = Nothing

    to the front to clean out any previous files while clearing errors and such.
    The lines you added doesn't do what you think. The code is now:
    Code:
    .......
        Dim WkBkA As Excel.Workbook  '<- create the variable
        Dim WkBkB As Excel.Workbook  '<- create the variable
        Dim WkBkC As Excel.Workbook  '<- create the variable
        Set WkBkC = Nothing'<- destroy the variable
        Set WkBkB = Nothing'<- destroy the variable
        Set WkBkA = Nothing'<- destroy the variable
        Set xlApp = Nothing
        .............
    By adding the "Set WkBkC = Nothing" lines where you did, you are destroying the reference to the variable, so the workbook is never opened.



    The output is always the same, and I get the popup - "The files are the same"
    You have the message in the wrong place.
    I added a Boolean variable to keep track if the files are the same or different.
    And I added code at the end to display a message if the files are the same or different.



    I tested the following code and it works for me.
    Code:
    Option Compare Database   '<<-- this line should be at the top of EVERY module
    Option Explicit           '<<-- this line should be at the top of EVERY module
    
    Private Sub comparetest_Click()
        Dim varSheetA As Variant
        Dim varSheetB As Variant
    
        Dim strRangeToCheck As String
    
        Dim iRow As Long
        Dim iCol As Long
    
        Dim bFilesIdentical As Boolean
    
        'for debugging
        Dim CellA
        Dim CellB
    
        Dim xlApp As Excel.Application
    
        Dim WkBkA As Excel.Workbook
        Dim WkBkB As Excel.Workbook
        Dim WkBkC As Excel.Workbook
    
        Dim wkSheetC As Excel.Worksheet
    
        'flag to indicate if the files are the same
        bFilesIdentical = True
        strRangeToCheck = "A1:I30"
    
        Set xlApp = New Excel.Application
    
        ' do not show Excel
        xlApp.Visible = False
    
        Set WkBkA = Workbooks.Open("C:\Temp\BalanceSheet_New.xlsx")
        Set varSheetA = WkBkA.Worksheets(1).Range(strRangeToCheck)
    
        Set WkBkB = Workbooks.Open("C:\Temp\BalanceSheet_old.xlsx")
        Set varSheetB = WkBkB.Worksheets(1).Range(strRangeToCheck)
    
        'show Excel
        '    xlApp.Visible = True
    
        'differences workbook
        Set WkBkC = Workbooks.Open("C:\Temp\Comparison.xlsx")
        Set wkSheetC = WkBkC.Worksheets(1)
    
        'copy header row from BalanceSheet_New.xlsx to Comparison.xlsx
        For iCol = 1 To 9
            wkSheetC.Cells(1, iCol) = varSheetA(1, iCol)
        Next iCol
    
    
        For iRow = 2 To 30
            For iCol = 1 To 9
                '            CellA = varSheetA(iRow, iCol)
                '            CellB = varSheetB(iRow, iCol)
                If varSheetA(iRow, iCol) <> varSheetB(iRow, iCol) Then
    
                    wkSheetC.Cells(iRow, iCol) = varSheetA(iRow, iCol) & "  ===>  " & varSheetB(iRow, iCol)
    
                    'files are not identical
                    bFilesIdentical = False
    
                End If
            Next iCol
        Next iRow
    
        WkBkC.Close SaveChanges:=True
        WkBkB.Close SaveChanges:=False
        WkBkA.Close SaveChanges:=False
    
        Excel.Application.Quit
    
        DoEvents
    
        Set WkBkC = Nothing
        Set WkBkB = Nothing
        Set WkBkA = Nothing
        Set xlApp = Nothing
    
    
        If bFilesIdentical Then
            MsgBox "The files are the SAME"
        Else
            MsgBox "The files are DIFFERENT"
        End If
    
        '    MsgBox "done"
    
    End Sub

  13. #13
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    That helps a lot, Thanks SSanfu Works as designed so far, w/ & w/o the files being the same.
    Option values are at the top of the module. I have it embedded in my Start form where all the command buttons are

  14. #14
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    Excellent!

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 3
    Last Post: 01-19-2016, 11:57 AM
  2. Convert Excel VBA to work in Access for Chart
    By tennisbuck in forum Programming
    Replies: 4
    Last Post: 12-26-2013, 12:12 AM
  3. How Trim work in Excel VBA
    By shabar in forum Programming
    Replies: 1
    Last Post: 02-04-2013, 10:36 PM
  4. Replies: 2
    Last Post: 02-09-2011, 05:19 PM
  5. Import Excel into access does not work
    By hawg1 in forum Import/Export Data
    Replies: 1
    Last Post: 05-28-2010, 12:05 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums