A
AD108
Hello,
I am using a static variable as a counter while looping through a set of
workbooks.
I want to set the value of the variable to 0 when the code is finished (in
case the user runs the code twice) but I am not sure how to do this. I cut
and pasted this app together, and don't know how all the individual parts
work. Not sure what variable to test before I set x to 0.
Sub OneName()
Application.ScreenUpdating = False
CloseWorkbooks
Dim MyPath As String
Call ClearFillRate
MyPath = ThisWorkbook.Path
Const FileName = "*Summary*.xls"
ProcessFiles MyPath, FileName
Application.ScreenUpdating = True
End Sub
Sub ProcessFiles(strFolder As String, strFilePattern As String)
Dim strFileName As String
Dim strFolders() As String
Dim iFolderCount As Integer
Dim i As Integer
Dim wb As Object
Dim wbCodeBook As Workbook
Dim dCases As Double
Dim dItems As Double
Dim dCasesRcv As Double
Dim dItemsRcv As Double
Dim strDate As String
Dim dLCases As Double
Dim dLItems As Double
Dim dLCasesRcv As Double
Dim dLItemsRcv As Double
Static x As Integer
Dim w As Workbook
Dim strBook As String
Application.ScreenUpdating = False
Set wbCodeBook = ThisWorkbook
For Each w In Application.Workbooks
w.Save
strBook = w.Name
If InStr(strBook, "Summary") = 0 Then
Else
w.Close savechanges:=True
End If
Next w
'Collect child folders
strFileName = Dir$(strFolder & "\", vbDirectory)
Do Until strFileName = ""
If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) =
vbDirectory Then
If Left$(strFileName, 1) <> "." Then
ReDim Preserve strFolders(iFolderCount)
strFolders(iFolderCount) = strFolder & "\" & strFileName
iFolderCount = iFolderCount + 1
End If
End If
strFileName = Dir$()
Loop
'process files in current folder
strFileName = Dir$(strFolder & "\" & strFilePattern)
Do Until strFileName = ""
'Debug.Print strFolder & "\" & strFileName
Dim strFile As String
strFile = strFolder & "\" & strFileName
Set wb = Workbooks.Open(strFile, True, False)
dCases = Sheets(3).Range("AC16").Value
dItems = Sheets(3).Range("AE16").Value
dCasesRcv = Sheets(3).Range("AD16").Value
dItemsRcv = Sheets(3).Range("AF16").Value
strDate = Sheets(3).Range("B1").Value
dLCases = Sheets(3).Range("AG16").Value
dLItems = Sheets(3).Range("AI16").Value
dLCasesRcv = Sheets(3).Range("AH16").Value
dLItemsRcv = Sheets(3).Range("AJ16").Value
wb.Close savechanges:=True
With Workbooks("Quarterly Fill Rate and Cube Rate.xls").Sheets("Data")
.Range("A2").Offset(x, 0).Value = strDate
.Range("B2").Offset(x, 0).Value = dCases
.Range("C2").Offset(x, 0).Value = dCasesRcv
.Range("E2").Offset(x, 0).Value = dItems
.Range("F2").Offset(x, 0).Value = dItemsRcv
.Range("I2").Offset(x, 0).Value = dLCases
.Range("J2").Offset(x, 0).Value = dLCasesRcv
.Range("L2").Offset(x, 0).Value = dLItems
.Range("M2").Offset(x, 0).Value = dLItemsRcv
End With
x = x + 1
'*******************************************
strFileName = Dir$()
Loop
'Look through child folders
For i = 0 To iFolderCount - 1
ProcessFiles strFolders(i), strFilePattern
Next i
Application.ScreenUpdating = True
End Sub
I am using a static variable as a counter while looping through a set of
workbooks.
I want to set the value of the variable to 0 when the code is finished (in
case the user runs the code twice) but I am not sure how to do this. I cut
and pasted this app together, and don't know how all the individual parts
work. Not sure what variable to test before I set x to 0.
Sub OneName()
Application.ScreenUpdating = False
CloseWorkbooks
Dim MyPath As String
Call ClearFillRate
MyPath = ThisWorkbook.Path
Const FileName = "*Summary*.xls"
ProcessFiles MyPath, FileName
Application.ScreenUpdating = True
End Sub
Sub ProcessFiles(strFolder As String, strFilePattern As String)
Dim strFileName As String
Dim strFolders() As String
Dim iFolderCount As Integer
Dim i As Integer
Dim wb As Object
Dim wbCodeBook As Workbook
Dim dCases As Double
Dim dItems As Double
Dim dCasesRcv As Double
Dim dItemsRcv As Double
Dim strDate As String
Dim dLCases As Double
Dim dLItems As Double
Dim dLCasesRcv As Double
Dim dLItemsRcv As Double
Static x As Integer
Dim w As Workbook
Dim strBook As String
Application.ScreenUpdating = False
Set wbCodeBook = ThisWorkbook
For Each w In Application.Workbooks
w.Save
strBook = w.Name
If InStr(strBook, "Summary") = 0 Then
Else
w.Close savechanges:=True
End If
Next w
'Collect child folders
strFileName = Dir$(strFolder & "\", vbDirectory)
Do Until strFileName = ""
If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) =
vbDirectory Then
If Left$(strFileName, 1) <> "." Then
ReDim Preserve strFolders(iFolderCount)
strFolders(iFolderCount) = strFolder & "\" & strFileName
iFolderCount = iFolderCount + 1
End If
End If
strFileName = Dir$()
Loop
'process files in current folder
strFileName = Dir$(strFolder & "\" & strFilePattern)
Do Until strFileName = ""
'Debug.Print strFolder & "\" & strFileName
Dim strFile As String
strFile = strFolder & "\" & strFileName
Set wb = Workbooks.Open(strFile, True, False)
dCases = Sheets(3).Range("AC16").Value
dItems = Sheets(3).Range("AE16").Value
dCasesRcv = Sheets(3).Range("AD16").Value
dItemsRcv = Sheets(3).Range("AF16").Value
strDate = Sheets(3).Range("B1").Value
dLCases = Sheets(3).Range("AG16").Value
dLItems = Sheets(3).Range("AI16").Value
dLCasesRcv = Sheets(3).Range("AH16").Value
dLItemsRcv = Sheets(3).Range("AJ16").Value
wb.Close savechanges:=True
With Workbooks("Quarterly Fill Rate and Cube Rate.xls").Sheets("Data")
.Range("A2").Offset(x, 0).Value = strDate
.Range("B2").Offset(x, 0).Value = dCases
.Range("C2").Offset(x, 0).Value = dCasesRcv
.Range("E2").Offset(x, 0).Value = dItems
.Range("F2").Offset(x, 0).Value = dItemsRcv
.Range("I2").Offset(x, 0).Value = dLCases
.Range("J2").Offset(x, 0).Value = dLCasesRcv
.Range("L2").Offset(x, 0).Value = dLItems
.Range("M2").Offset(x, 0).Value = dLItemsRcv
End With
x = x + 1
'*******************************************
strFileName = Dir$()
Loop
'Look through child folders
For i = 0 To iFolderCount - 1
ProcessFiles strFolders(i), strFilePattern
Next i
Application.ScreenUpdating = True
End Sub