PDA

View Full Version : Need help comparing worksheets



had1015
04-23-2008, 07:17 AM
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:


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


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:


LeftFooter = "&""Arial""Data Date: " & DateStamp
DateStamp = Format(FileDateTime(ImportFileName), "dddd, mm-dd-yyyy")

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.

Bob Phillips
04-23-2008, 07:41 AM
I haven't tested this as I have nothing to test it on, but hopefully it will get you started



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

had1015
04-23-2008, 08:01 AM
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


Else
Set mpWB1 = Workbooks(mpFile2).Open

Bob Phillips
04-23-2008, 08:20 AM
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.



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



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

had1015
04-23-2008, 08:21 AM
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

had1015
04-23-2008, 08:28 AM
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.

Bob Phillips
04-23-2008, 08:44 AM
Yeah, that is how I read it, so I open both files and process them.

had1015
04-23-2008, 09:47 AM
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.

Bob Phillips
04-23-2008, 10:08 AM
Have you tried my code?

had1015
04-23-2008, 10:19 AM
Yes I've tried. The results were on my previous post.
Thanks.

Simon Lloyd
04-23-2008, 12:40 PM
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.