Hello All
I have a userform with a combo box that is populated by a named range which returns a selected fiscal period (example: MAY-18). A user will select the period that corresponds with the file name they wish to open with the macro in order to pull cost data. Unfortunately I am getting my self populated error message that the selected file name is not in the folder. I am lost as to what I did wrong so I am deferring to the wizards for assistance.
In short:
1. User clicks macro button to call the userform
2. User manually inputs a job number in the userform textbox
3. User selects fiscal month via combobox dropdown list
4. User clicks OK and the macro should go into the shared file location and search for the file name that corresponds with the fiscal month selected example MAY-18.xlsx
I'm sure my code below is armature at best since I am far from fluent in VBA so any additional notes beyond my above question is greatly appreciated.
Thank you
I have a userform with a combo box that is populated by a named range which returns a selected fiscal period (example: MAY-18). A user will select the period that corresponds with the file name they wish to open with the macro in order to pull cost data. Unfortunately I am getting my self populated error message that the selected file name is not in the folder. I am lost as to what I did wrong so I am deferring to the wizards for assistance.
In short:
1. User clicks macro button to call the userform
2. User manually inputs a job number in the userform textbox
3. User selects fiscal month via combobox dropdown list
4. User clicks OK and the macro should go into the shared file location and search for the file name that corresponds with the fiscal month selected example MAY-18.xlsx
I'm sure my code below is armature at best since I am far from fluent in VBA so any additional notes beyond my above question is greatly appreciated.
Thank you
Rich (BB code):
Private Sub cmdOK_Click()
On Error GoTo Handler
Dim shtDest, shtSource As Worksheet
Dim wbSource As Workbook
Dim strJN As String
Dim strGLP As String
Dim strURL As String
Dim tblActualCost As ListObject
Dim tblRows As Long
Dim Rng As Range
Dim LastRowSource, LastRowDest, LastRow As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set shtDest = ThisWorkbook.Sheets("Actual Cost")
Set tblActualCost = shtDest.ListObjects("ActualCost_Table")
strJN = txtJN.Text
strGLP = cboGLP.Value
strURL = "SAMPLE FILE PATH Programs\1 - Program Tracker Master Files\Exp Detail Report" & strGLP & ".xlsx"
If Dir(strURL) <> "" Then
With shtDest.Range
.AutoFilter Field:=12, Criteria1:=strGLP
LastRow = shtDest.Range("A2:K" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
If LastRow > 1 Then
Set Rng = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
.AutoFilter
Rng.Delete
LastRow = shtDest.Range("A2:K" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row + 1
.Range("D" & LastRow).Value = strGLP
Else
shtDest.ShowAllData
LastRow = shtDest.Range("A2:K" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row + 1
.Range("D" & LastRow).Value = strGLP
End If
End With
Workbooks.Open strURL, False, True
Set wbSource = ActiveWorkbook
Set shtSource = ActiveSheet
'Filter the Cost Detail Report for the JN
LastRowSource = shtSource.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastRowDest = tblActualCost.Range("A2:K" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row + 1
'shtSource.Range("$A$1:$K$" & LastRowSource).AutoFilter Field:=1, Criteria1:=strJN, Operator:=xlAnd
shtSource.Range("$A$1:$K$1").AutoFilter Field:=1, Criteria1:=strJN, Operator:=xlAnd
If LastRowSource > 1 Then
shtSource.Range("A2:K" & LastRowSource).Copy
shtDest.Range("A" & LastRowDest).Offset(0, 0).PasteSpecial xlPasteValues
Else
shtDest.ShowAllData
End If
Application.CutCopyMode = False
Application.EnableEvents = False
wbTracker.Close False
Application.EnableEvents = True
tblRows = shtDest.Cells(Rows.Count, "D").End(xlUp).Row
tblActualCost.Resize tblActualCost.Range.Resize(tblRows)
With tblActualCost.Range
LastRow = tblActualCost.Range("A2:K" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row + 1
.Range("L" & LastRow).Formula = "=INDEX(Cal_FY,MATCH(D" & LastRow & ",Cal_GLPeriod,0))"
.Range("M" & LastRow).Formula = "=INDEX(Cal_FP,MATCH(D" & LastRow & ",Cal_GLPeriod,0))"
.Range("N" & LastRow).Formula = "=IFERROR(IF(AND(E" & LastRow & "=Mfg_Resource,OR(J" & LastRow & "=Blank_Cell,J" & LastRow & "=0)),Mfg,INDEX(ExpLbrCat_ExpLbrCat,MATCH(J" & LastRow & ",ExpLbrCat_OracleExpType,0)))&O" & LastRow & ",0)"
.Range("O" & LastRow).Formula = "=INDEX(ExpLbrCat_ExpLbrCat,MATCH(E2,ExpLbrCat_OracleExpType,0))"
.Range("P" & LastRow).Formula = "=M" & LastRow & "&O" & LastRow
.Range("Q" & LastRow).Formula = "=L" & LastRow & "&O" & LastRow
.Range("R" & LastRow).Formula = "=$M" & LastRow & "&E" & LastRow
.Range("S" & LastRow).Formula = "=IF(N" & LastRow & "=0,0,L" & LastRow & "&N" & LastRow & ")"
.Range("T" & LastRow).Formula = "=IF(N" & LastRow & "=0,0,M" & LastRow & "&N" & LastRow & ")"
End With
shtDest.Calculate
Range("ActualCost_Table[[FY]:[FP&LbrCat]]").Copy
shtDest.Range("L2").PasteSpecial xlPasteValues
Else
MsgBox "The " & strGLP & " Cost Detail file does not exist" & vbCrLf & "Please enter another GL Period", vbInformation, "Cost Detail file doesn't exist"
End If
Sheets("Control").Select
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set shtDest = Nothing
Set tblActualCost = Nothing
Set Rng = Nothing
Set wbSource = Nothing
Set shtSource = Nothing
Handler:
If Err.Number = 1004 Then
MsgBox Err.Number & ": " & Err.Description, vbCritical, "File Not Found"
Else
MsgBox Err.Number & ": " & Err.Description, vbCritical, "Unhandled Exception"
End If
End Sub