Consulting

Results 1 to 11 of 11

Thread: Need help comparing worksheets

  1. #1
    VBAX Regular
    Joined
    Sep 2007
    Location
    Virginia
    Posts
    49
    Location

    Smile Need help comparing worksheets

    Hi

    I am truely grateful for all of the information that you experts provide to us novice vba users and students. I need help as I've been trying to develop code for weekly reports we run at my place of employment.

    I have 2 files located in a folder on our shared drive. Both files contain the same types of information and are formatted alike. They are actually reports that are run once per week. I need to be able to look at the most recent report and if the same data in column F is on the previous week's report, which is in the same folder, in column F also, then I'd like to delete this info and only show the new items. I'd like the entire row to be deleted in the most recent file. The tab names are the same on each report. Fortunately I was able to obtain a macro for this forum to help me to bring both files into the same workbook. This is the macro:

    [VBA]
    Option Explicit

    '32-bit API declarations
    Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
    pszpath As String) As Long

    Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) _
    As Long

    Public Type BrowseInfo
    hOwner As Long
    pIDLRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
    End Type

    Function GetDirectory(Optional msg) As String
    On Error Resume Next
    Dim bInfo As BrowseInfo
    Dim path As String
    Dim r As Long, x As Long, pos As Integer

    'Root folder = Desktop
    bInfo.pIDLRoot = 0&

    'Title in the dialog
    If IsMissing(msg) Then
    bInfo.lpszTitle = "Please select the folder of the excel files to copy."
    Else
    bInfo.lpszTitle = msg
    End If

    'Type of directory to return
    bInfo.ulFlags = &H1

    'Display the dialog
    x = SHBrowseForFolder(bInfo)

    'Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
    pos = InStr(path, Chr$(0))
    GetDirectory = Left(path, pos - 1)
    Else
    GetDirectory = ""
    End If
    End Function

    Sub CombineFiles()
    Dim path As String
    Dim FileName As String
    Dim LastCell As Range
    Dim Wkb As Workbook
    Dim WS As Worksheet
    Dim ThisWB As String

    ThisWB = ThisWorkbook.Name
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    path = GetDirectory
    FileName = Dir(path & "\*.xls", vbNormal)
    Do Until FileName = ""
    If FileName <> ThisWB Then
    Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
    For Each WS In Wkb.Worksheets
    Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
    If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
    Else
    WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    End If
    Next WS
    Wkb.Close False
    End If
    FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True


    Set Wkb = Nothing
    Set LastCell = Nothing
    End Sub

    [/VBA]
    I forgot the name of the expert that created it but I am truely grateful.

    I now would appreciate if someone could help me look at he datestamp on the left footer and determine which file is the most recent. This is the code that is used for the datestamp:

    [VBA]
    LeftFooter = "&""Arial""Data Date: " & DateStamp
    DateStamp = Format(FileDateTime(ImportFileName), "dddd, mm-dd-yyyy")
    [/VBA]
    I would first like for these new worksheets to be placed in a new workbook that does not contain the macro. I would also like to have a macro to look at the most recent sheet and compare it to the previous week's sheet and if the data in column F matches column F of this sheet, I'd like to delete it in the most recent worksheet.
    There will be only 2 files in the folder at one time. Also, row numbers will vary from week to week so Vlookup function may have to be implemented to determine the matching data. I have headers in these reports in row 1. I use columns A thru P or 16 coulmns of data. I will then save this new file to the sahred drive in the same folder naming it filtered results. Any help would be greatly appreciated.

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    I haven't tested this as I have nothing to test it on, but hopefully it will get you started

    [vba]

    Sub ProcessFiles()
    Dim mpFolder As String
    Dim mpFile1 As String
    Dim mpFile2 As String
    Dim mpWB1 As Workbook
    Dim mpWB2 As Workbook
    Dim mpWB3 As Workbook

    With Application.FileDialog(msoFileDialogFolderPicker)

    .AllowMultiSelect = False
    If .Show = -1 Then

    mpFolder = .SelectedItems(1)
    mpFile1 = Dir(mpFolder & Application.PathSeparator & "*.xls", vbNormal)

    If mpFile1 <> "" Then

    mpFile2 = Dir
    End If

    If mpFile1 = "" Or mpFile2 = "" Then

    MsgBox "Incomplete files - exitting", vbCritical, "File Details"
    Exit Sub
    End If

    If FileDateTime(mpFile1) < FileDateTime(mpFile2) Then

    Set mpWB1 = Workbooks(mpFile1).Open
    Set mpWB2 = Workbooks(mpFile2).Open
    Else
    Set mpWB1 = Workbooks(mpFile2).Open
    Set mpWB2 = Workbooks(mpFile1).Open
    End If

    mpWB1.Worksheets(1).Copy
    Set mpWB3 = ActiveWorkbook
    mpWB1.Worksheets(1).Copy After:=mpWB3.Worksheets(1)

    With mpWB3.Worksheets(2)

    mpLastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
    For i = LastRow To 1

    If .Cells(i, "F").Value = mpWB3.Worksheets(1).Cells(i, "F").Value Then

    .Rows(i).Delete
    End If
    Next i
    End With
    End If
    End With

    End Sub
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Regular
    Joined
    Sep 2007
    Location
    Virginia
    Posts
    49
    Location
    Thanks for your quick response. My filename is Weelky Report and the date is next to it.

    I tried this code but got a runtime error 9 subscript out of range error when it reach this

    [VBA]
    Else
    Set mpWB1 = Workbooks(mpFile2).Open
    [/VBA]

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Quote Originally Posted by had1015
    Thanks for your quick response. My filename is Weelky Report and the date is next to it.
    What is the releveance of that. You said the directory will only hold two files, so I just open them both.

    Quote Originally Posted by had1015
    I tried this code but got a runtime error 9 subscript out of range error when it reach this

    Else
    Set mpWB1 = Workbooks(mpFile2).Open
    Sorry my bad

    [vba]

    Sub ProcessFiles()
    Dim mpFolder As String
    Dim mpFile1 As String
    Dim mpFile2 As String
    Dim mpWB1 As Workbook
    Dim mpWB2 As Workbook
    Dim mpWB3 As Workbook
    Dim mpLastRow As Long
    Dim i As Long

    With Application.FileDialog(msoFileDialogFolderPicker)

    .AllowMultiSelect = False
    If .Show = -1 Then

    mpFolder = .SelectedItems(1)
    mpFile1 = Dir(mpFolder & Application.PathSeparator & "*.xls", vbNormal)

    If mpFile1 <> "" Then

    mpFile2 = Dir
    End If

    If mpFile1 = "" Or mpFile2 = "" Then

    MsgBox "Incomplete files - exitting", vbCritical, "File Details"
    Exit Sub
    End If

    If FileDateTime(mpFile1) < FileDateTime(mpFile2) Then

    Set mpWB1 = Workbooks.Open(mpFile1)
    Set mpWB2 = Workbooks.Open(mpFile2)
    Else
    Set mpWB1 = Workbooks.Open(mpFile2)
    Set mpWB2 = Workbooks.Open(mpFile1)
    End If

    mpWB1.Worksheets(1).Copy
    Set mpWB3 = ActiveWorkbook
    mpWB2.Worksheets(1).Copy After:=mpWB3.Worksheets(1)

    With mpWB3.Worksheets(2)

    mpLastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
    For i = mpLastRow To 1

    If .Cells(i, "F").Value = mpWB3.Worksheets(1).Cells(i, "F").Value Then

    .Rows(i).Delete
    End If
    Next i
    End With
    End If
    End With

    End Sub
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  5. #5
    VBAX Regular
    Joined
    Sep 2007
    Location
    Virginia
    Posts
    49
    Location
    I have combined the workbooks into 2 sheets. If the recent report is in Sheet2 and the prior report is in Sheet1, while I'm currently in Sheet2 what code would be used to look at Sheet1 one in column F (look at rows say 1000 max rows) and if the same data is found in coulmn F of Sheet2, delete the row in Sheet2.

    Thanks

  6. #6
    VBAX Regular
    Joined
    Sep 2007
    Location
    Virginia
    Posts
    49
    Location
    Sorry, I must had said it incorrectly. What I meant was that only 2 files will be in the folder at one time. These will be the files used for the comparison. I place the other files in the archives folder.

  7. #7
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Yeah, that is how I read it, so I open both files and process them.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  8. #8
    VBAX Regular
    Joined
    Sep 2007
    Location
    Virginia
    Posts
    49
    Location
    Thanks XLD,

    I now have both original workbooks opened and a new book with both sheets in them. However they are still listing the original row amounts. I would like the new book to have deleted all rows that have the same data in column F starting with F2. This would leave only the rows of new additions that have accumulated within the recent list. The row positions could have changed for these items so what shows in F37 in the earlier file might show in F62 in the recent file, however I'd like this to be deleted in the new recent report file.

    Thanks again I really appreciate your help.

  9. #9
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Have you tried my code?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  10. #10
    VBAX Regular
    Joined
    Sep 2007
    Location
    Virginia
    Posts
    49
    Location
    Yes I've tried. The results were on my previous post.
    Thanks.

  11. #11
    Moderator VBAX Guru Simon Lloyd's Avatar
    Joined
    Sep 2005
    Location
    UK
    Posts
    3,003
    Location
    had1015, when posting code could you please wrap it in the VBA code tags as xld has done in his responses, to do this you highlight all your pasted code then click the green VBA button at the top of your Edit/New Post window, that way it will be easier to distinguish from text and it gets indented so you can identify the sections of code easier.
    Regards,
    Simon
    Please read this before cross posting!
    In the unlikely event you didn't get your answer here try Microsoft Office Discussion @ The Code Cage
    If I have seen further it is by standing on the shoulders of giants.
    Isaac Newton, Letter to Robert Hooke, February 5, 1675 English mathematician & physicist (1642 - 1727)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •