Emoncada
04-17-2008, 05:51 AM
I have this code
Sub CopyToMasterDR()
Dim lngRow As Long
Dim wb As Workbook
Dim FileCount As Long 'Added for no files found check
Dim strPath As String
Dim strFile As String
Dim wbMaster As Workbook
Dim c As Range
Dim my As Range
On Error GoTo ErrHandler
Application.ScreenUpdating = False
' this assumes that the master workbook is active
Set wbMaster = ActiveWorkbook
'Make sure dir exists! Note hard coded Drive/Dir name and
' also VBA generated spaces in Month/Year and Month/Day eg:
' "S:\Depot Outgoing 2008\2007\Dec 2007\Dec 27\"
StartDate = Format(Worksheets("Master").Range("c1").Value, "yyyy")
MiddleDate = Format(Worksheets("Master").Range("c1").Value, "mmmm yyyy")
EndDate = Format(Worksheets("Master").Range("c1").Value, "mmm dd")
'Missing path separator in original code, Corrected with \
strPath = "S:\Depot Outgoing 2008\" & StartDate & "\" & MiddleDate & "\" & EndDate & "\"
strFile = Dir(strPath & "*.xls", vbNormal)
' loop through all files in the folder
Do Until strFile = ""
' if the master is in the same folder, make sure it's excluded
'Added UCASE to do proper check
If UCase(strFile) <> "MASTER PIM.XLS" Then
'At least one file found. Mark as such.
FileCount = 1
' find last row in column B
lngRow = wbMaster.Sheets("Master").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
Workbooks.Open strPath & strFile
Set wb = ActiveWorkbook
' copy the data diorectly to master sheet (sheet 1)
wb.Sheets(1).Range("a2:O5000").Copy wbMaster.Sheets(1).Range("A" & lngRow)
wbMaster.Activate
'Recopy for PasteSpecial operation (kludge)
wb.Sheets(1).Range("a2:O5000").Copy
'Full command
ActiveWorkbook.Sheets("Master").Range("A" & lngRow).PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
wb.Close False
End If
' find next file
strFile = Dir()
Loop
With Master
If Range("J1").Value = "All" Then
Range("A2:O5000").Select
ActiveWindow.LargeScroll ToRight:=-1
Selection.AutoFilter
Selection.AutoFilter Field:=8
Set my = ActiveSheet.Range("H2:H5000")
For Each c In my
If c.Value = "MORTGAGE" Then c.EntireRow.Hidden = True
Next
Else
Range("A2:O5000").Select
ActiveWindow.LargeScroll ToRight:=-1
Selection.AutoFilter
Selection.AutoFilter Field:=8, Criteria1:=Range("J1")
End If
Rows("3:5000").SpecialCells(xlVisible).Copy
End With
ExitHere:
'Check for no files found, inform user
If FileCount < 1 Then
MsgBox ("No files found in Directory " & strPath)
End If
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Number & ": " & Err.Description
Application.ScreenUpdating = True
End Sub
I want to know if there is someway i can have it pull data for two ranges of dates. So If I want to pull from 1/1/08 - 4/16/08 is there a way this can be done.
Sub CopyToMasterDR()
Dim lngRow As Long
Dim wb As Workbook
Dim FileCount As Long 'Added for no files found check
Dim strPath As String
Dim strFile As String
Dim wbMaster As Workbook
Dim c As Range
Dim my As Range
On Error GoTo ErrHandler
Application.ScreenUpdating = False
' this assumes that the master workbook is active
Set wbMaster = ActiveWorkbook
'Make sure dir exists! Note hard coded Drive/Dir name and
' also VBA generated spaces in Month/Year and Month/Day eg:
' "S:\Depot Outgoing 2008\2007\Dec 2007\Dec 27\"
StartDate = Format(Worksheets("Master").Range("c1").Value, "yyyy")
MiddleDate = Format(Worksheets("Master").Range("c1").Value, "mmmm yyyy")
EndDate = Format(Worksheets("Master").Range("c1").Value, "mmm dd")
'Missing path separator in original code, Corrected with \
strPath = "S:\Depot Outgoing 2008\" & StartDate & "\" & MiddleDate & "\" & EndDate & "\"
strFile = Dir(strPath & "*.xls", vbNormal)
' loop through all files in the folder
Do Until strFile = ""
' if the master is in the same folder, make sure it's excluded
'Added UCASE to do proper check
If UCase(strFile) <> "MASTER PIM.XLS" Then
'At least one file found. Mark as such.
FileCount = 1
' find last row in column B
lngRow = wbMaster.Sheets("Master").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
Workbooks.Open strPath & strFile
Set wb = ActiveWorkbook
' copy the data diorectly to master sheet (sheet 1)
wb.Sheets(1).Range("a2:O5000").Copy wbMaster.Sheets(1).Range("A" & lngRow)
wbMaster.Activate
'Recopy for PasteSpecial operation (kludge)
wb.Sheets(1).Range("a2:O5000").Copy
'Full command
ActiveWorkbook.Sheets("Master").Range("A" & lngRow).PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
wb.Close False
End If
' find next file
strFile = Dir()
Loop
With Master
If Range("J1").Value = "All" Then
Range("A2:O5000").Select
ActiveWindow.LargeScroll ToRight:=-1
Selection.AutoFilter
Selection.AutoFilter Field:=8
Set my = ActiveSheet.Range("H2:H5000")
For Each c In my
If c.Value = "MORTGAGE" Then c.EntireRow.Hidden = True
Next
Else
Range("A2:O5000").Select
ActiveWindow.LargeScroll ToRight:=-1
Selection.AutoFilter
Selection.AutoFilter Field:=8, Criteria1:=Range("J1")
End If
Rows("3:5000").SpecialCells(xlVisible).Copy
End With
ExitHere:
'Check for no files found, inform user
If FileCount < 1 Then
MsgBox ("No files found in Directory " & strPath)
End If
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Number & ": " & Err.Description
Application.ScreenUpdating = True
End Sub
I want to know if there is someway i can have it pull data for two ranges of dates. So If I want to pull from 1/1/08 - 4/16/08 is there a way this can be done.