Hi all,
I've been wrestling with Excel for a few days on this one, and I'm hoping someone can end my misery.
I have a sub (Import_Properties) that is played when the user clicks a button. After the user selects the files to import, the code transfers the data to the main workbook. After each file's data is imported, a sub runs that sums up all of these imported tabs on a "rollup" tab. However, I cannot get the code to run all the way through UNLESS I press play from inside the module OR I put in break points and step through the code.
How can I get this to work correctly by clicking the button that is attached to the Import_Properties sub?!?
Thanks for taking the time to read through,
-Clint
I've been wrestling with Excel for a few days on this one, and I'm hoping someone can end my misery.
I have a sub (Import_Properties) that is played when the user clicks a button. After the user selects the files to import, the code transfers the data to the main workbook. After each file's data is imported, a sub runs that sums up all of these imported tabs on a "rollup" tab. However, I cannot get the code to run all the way through UNLESS I press play from inside the module OR I put in break points and step through the code.
How can I get this to work correctly by clicking the button that is attached to the Import_Properties sub?!?
Thanks for taking the time to read through,
-Clint
Code:
Option Explicit
Option Base 1
Sub Import_Properties()
Dim FilePath As Variant
Dim FileName As String
Dim i As Long
Dim x As Long
Dim sht As Worksheet
Dim wsImportTo As Worksheet
Application.ScreenUpdating = False
MsgBox "Please nagivate to and select ALL of the property files at the same time." & vbCrLf & _
"Use Ctrl and/or Shift to choose multiple files at once.", vbOKOnly, "Select Files to Import"
FilePath = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select All of the Property Files", MultiSelect:=True)
If IsArray(FilePath) = False Then
Exit Sub
End If
'delete all the imported sheets in this file
Application.DisplayAlerts = False
For i = ThisWorkbook.Sheets.Count To 1 Step -1
If Left(ThisWorkbook.Sheets(i).CodeName, 5) = "Sheet" Then
ThisWorkbook.Sheets(i).Delete
End If
Next
Application.DisplayAlerts = True
'cycle through each selected file
For i = LBound(FilePath) To UBound(FilePath)
'check to make sure the file isn't already open
For x = 1 To Workbooks.Count
If Workbooks(x).Name = GetFileName(CStr(FilePath(i))) Then
MsgBox "Please close " & GetFileName(CStr(FilePath(i))) & " and try your import again.", vbExclamation, "File Open"
GoTo ExitSubOnError
End If
Next
'open the file
Workbooks.Open GetFileName(CStr(FilePath(i)))
'look for the data sheet
For Each sht In Workbooks(GetFileName(CStr(FilePath(i)))).Worksheets
If sht.Name = "Need Date Summary" Then
'add a new sheet to this file. This is where the imported data will go
Set wsImportTo = ThisWorkbook.Sheets.Add(, Rollup)
'rename the sheet to the MARSHA code
On Error Resume Next
wsImportTo.Name = sht.Range("G2")
On Error GoTo 0
'transfer the data
wsImportTo.Range("B2:W29").Value = sht.Range("B2:W29").Value
Exit For
End If
Next
'close the file
Workbooks(GetFileName(CStr(FilePath(i)))).Close False
Next
SUMIF3D
ExitSubOnError:
Rollup.Activate
Application.ScreenUpdating = True
End Sub
Private Function GetFileName(FilePath As String) As String
Dim PathArray
PathArray = Split(FilePath, Application.PathSeparator)
GetFileName = PathArray(UBound(PathArray))
End Function
Sub SUMIF3D()
'This sub is used to sum all of the individual property tabs and put the values on the 'Rollup' tab
Dim f As Long
Dim j As Long
Dim y As Long
Dim z As Variant
Dim rngToCalculate As Range
Set rngToCalculate = Rollup.Range("Range_to_Calculate")
'cycle through each cell in the range to calculate
For Each z In rngToCalculate
j = 0
'cycle through all sheets in this workbook
For f = 1 To ThisWorkbook.Sheets.Count
'look for sheets whose codename starts with "Sheet"
If Left(ThisWorkbook.Sheets(f).CodeName, 5) = "Sheet" Then
'if found, cycle through the years row (columns 4 to 23) to match the year in the column of the caller cell
For y = 4 To 23
If ThisWorkbook.Sheets(f).Cells(4, y).Value = Rollup.Cells(4, z.Column).Value Then
'if there's a match, add the value to J
j = j + ThisWorkbook.Sheets(f).Cells(z.Row, y)
Exit For
End If
Next
End If
Next
'put the value in the current cell
z.Value = j
Next
End Sub