SBrooky
09-14-2012, 06:22 AM
Hello,
I have a trouble with one of my loops I dont understand where i've gone wrong:
Option Explicit
Sub GetSummary()
Dim xRow&, vSF, xList&, xMonth&
Dim xMonthRange, xMDR, xDDR As Range
Dim xDirect$, InitialFoldr$
Dim wb As Workbook
Set wb = Workbooks("Main.xlsm")
Application.ScreenUpdating = False
InitialFoldr$ = "./" '<<< Startup folder to begin searching from
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
End If
End With
If xDirect$ <> "" Then
With CreateObject("Scripting.FileSystemObject").GetFolder(xDirect$)
For Each vSF In .subfolders
Worksheets("Summary").Range("C5").Offset(xRow) = Mid(vSF, InStrRev(vSF, "\") + 1)
Worksheets("Summary").Range("AA5").Offset(xList) = vSF
Application.Workbooks.Open (vSF & "\Monthly engagement measure.xlsm"), ReadOnly:=True
'1:1 data
'create TL sheet
wb.Sheets.Add.Name = Mid(vSF, InStrRev(vSF, "\") + 1)
Set xMonthRange = Workbooks("Main.xlsm").Sheets("Summary").Range("E4")
Set xMDR = Workbooks("Main.xlsm").Sheets(Mid(vSF, InStrRev(vSF, "\") + 1)).Range("A1")
Set xDDR = Workbooks("Main.xlsm").Sheets(Mid(vSF, InStrRev(vSF, "\") + 1)).Range("A2:D50")
'Get the first month and put it in first column
Do Until xMonth = 15
wb.Sheets(Mid(vSF, InStrRev(vSF, "\") + 1)).Range(xMDR).Value = xMonthRange
wb.Sheets(Mid(vSF, InStrRev(vSF, "\") + 1)).Range(xDDR).Value = Workbooks("Monthly engagement measure.xlsm").Sheets(xMonthRange).Range("B6:E50").Value
xMonth = xMonth + 1
xMonthRange = xMonthRange.Offset(, 1)
xMDR = xMDR.Offset(, 5)
xDDR = xDDR.Offset(, 5)
Loop
xMonth = 0
xRow = xRow + 1
xList = xList + 1
Workbooks("Monthly engagement measure.xlsm").Close SaveChanges:=False
Next vSF
End With
I get the error on line:
wb.Sheets(Mid(vSF, InStrRev(vSF, "\") + 1)).Range(xMDR).Value = xMonthRange
Any ideas?
I have a trouble with one of my loops I dont understand where i've gone wrong:
Option Explicit
Sub GetSummary()
Dim xRow&, vSF, xList&, xMonth&
Dim xMonthRange, xMDR, xDDR As Range
Dim xDirect$, InitialFoldr$
Dim wb As Workbook
Set wb = Workbooks("Main.xlsm")
Application.ScreenUpdating = False
InitialFoldr$ = "./" '<<< Startup folder to begin searching from
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
End If
End With
If xDirect$ <> "" Then
With CreateObject("Scripting.FileSystemObject").GetFolder(xDirect$)
For Each vSF In .subfolders
Worksheets("Summary").Range("C5").Offset(xRow) = Mid(vSF, InStrRev(vSF, "\") + 1)
Worksheets("Summary").Range("AA5").Offset(xList) = vSF
Application.Workbooks.Open (vSF & "\Monthly engagement measure.xlsm"), ReadOnly:=True
'1:1 data
'create TL sheet
wb.Sheets.Add.Name = Mid(vSF, InStrRev(vSF, "\") + 1)
Set xMonthRange = Workbooks("Main.xlsm").Sheets("Summary").Range("E4")
Set xMDR = Workbooks("Main.xlsm").Sheets(Mid(vSF, InStrRev(vSF, "\") + 1)).Range("A1")
Set xDDR = Workbooks("Main.xlsm").Sheets(Mid(vSF, InStrRev(vSF, "\") + 1)).Range("A2:D50")
'Get the first month and put it in first column
Do Until xMonth = 15
wb.Sheets(Mid(vSF, InStrRev(vSF, "\") + 1)).Range(xMDR).Value = xMonthRange
wb.Sheets(Mid(vSF, InStrRev(vSF, "\") + 1)).Range(xDDR).Value = Workbooks("Monthly engagement measure.xlsm").Sheets(xMonthRange).Range("B6:E50").Value
xMonth = xMonth + 1
xMonthRange = xMonthRange.Offset(, 1)
xMDR = xMDR.Offset(, 5)
xDDR = xDDR.Offset(, 5)
Loop
xMonth = 0
xRow = xRow + 1
xList = xList + 1
Workbooks("Monthly engagement measure.xlsm").Close SaveChanges:=False
Next vSF
End With
I get the error on line:
wb.Sheets(Mid(vSF, InStrRev(vSF, "\") + 1)).Range(xMDR).Value = xMonthRange
Any ideas?