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.
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.