Sub ImportDataCAF()
'Each variable must have the type.
Dim r As Long, row As Long 'row count
Dim PC As String, ED As String, TD As String
Dim HDW_D As String, MATL_D As String, TRS_D As String, HRL_D As String
Dim DRV As String, JC As String, BLDR As String, TRACT As String, Filename As String
Dim fullPath As String, bookName As String, shName1 As String, shName2 As String
'...Prevent from Formulas filling all the way down
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.AutoCorrect.AutoFillFormulasInLists = False
Application.DisplayAlerts = False
Application.EnableEvents = False
'...Setup
CAFdir.Select
row = Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
PC = "]MB'!$AJ$4"
ED = "]MB'!$AP$4"
TD = "]MB'!$AP$5"
HDW_D = "]MB'!$G$7"
MATL_D = "]MB'!$M$7"
TRS_D = "]MB'!$U$7"
HRL_D = "]LB'!$L$9"
For r = 2 To row
'...uses data provided in Columns A:E to create reference
DRV = "='" & CAFdir.Cells(r, 1).Value
JC = "\" & CAFdir.Cells(r, 2).Value
BLDR = "\" & CAFdir.Cells(r, 3).Value
TRACT = "\" & CAFdir.Cells(r, 4).Value
Filename = "\[" & CAFdir.Cells(r, 5).Value
fullPath = Join(Application.Transpose(Application.Transpose(Range("A" & r & ":D" & r).Value)), "\")
bookName = Range("E" & r).Value
shName1 = "MB"
If HasSheet(fullPath, bookName, shName1) Then
CAFdir.Cells(r, 6).Formula = DRV & JC & BLDR & TRACT & Filename & PC
CAFdir.Cells(r, 7).Formula = DRV & JC & BLDR & TRACT & Filename & ED
CAFdir.Cells(r, 8).Formula = DRV & JC & BLDR & TRACT & Filename & TD
CAFdir.Cells(r, 9).Formula = DRV & JC & BLDR & TRACT & Filename & HDW_D
CAFdir.Cells(r, 10).Formula = DRV & JC & BLDR & TRACT & Filename & MATL_D
CAFdir.Cells(r, 11).Formula = DRV & JC & BLDR & TRACT & Filename & TRS_D
Else
CAFdir.Cells(r, 6).Value = 0
CAFdir.Cells(r, 7).Value = 0
CAFdir.Cells(r, 8).Value = 0
CAFdir.Cells(r, 9).Value = 0
CAFdir.Cells(r, 10).Value = 0
CAFdir.Cells(r, 11).Value = 0
End If
shName1 = "LB"
If HasSheet(fullPath, bookName, shName1) Then
CAFdir.Cells(r, 12).Formula = DRV & JC & BLDR & TRACT & Filename & HRL_D
Else
CAFdir.Cells(r, 12).Value = 0
End If
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.AutoCorrect.AutoFillFormulasInLists = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Function HasSheet(fPath As String, fName As String, sheetName As String)
Dim f As String
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
f = "'" & fPath & "[" & fName & "]" & sheetName & "'!R1C1"
HasSheet = Not IsError(Application.ExecuteExcel4Macro(f))
End Function
