We help IT Professionals succeed at work.

VBA Error

I have been tryig to finish up an import feature in an Excel Report. First let me say I dont know much of anything regarding VB. A friend of mine has been writing the macro for me but he is unavailable during the day.

I am getting a compile error on line 65; "Sub of Function nod defined" After selecting OK to the error message, it automatically highlights "FileExists" Line 65,Col18

See the attached code.
Private Sub cmdImport_Click()
'Purpose: Import button for user to click (launches initial function).


Set wksMaster = Worksheets("MASTER")        'Set master worksheet reference to current workbook / MASTER sheet (tab).  This tab name must not change or will need to be updated!
'DISABLE AUTO CALCULATIONS UNTIL IMPORT IS COMPLETE AND THEN RECALCULATE SHEET!
Excel.Application.Calculation = xlCalculationManual

GetRegistrySettings
ImportDataFromWorksheet

'RE-ENABLE CALCULATIONS!
Excel.Application.Calculation = xlCalculationAutomatic          'I believe this is automatically recalculating the master spreadsheet once this is enabled again
'Excel.Application.Calculate                                    'But if not, enable this line and that should fix it.


Set wksMaster = Nothing                     'Dispose object; do not close workbook as user is still using [THIS] workbook for importing . . .

ReDim arrProjectName(0): ReDim arrAccountingCode(0): ReDim arrStatus(0)                             'Empty all used arrays
ReDim arrEntity(0): ReDim arrMileage(0): ReDim arrTotals(0)                                         'Empty all used arrays

End Sub

Private Function GetRegistrySettings()
strInitDlgPath = GetSetting("Forecast Importer", "Variables", "DefaultPath", "")
End Function

Public Function ImportDataFromWorksheet()
'Purpose: Open source worksheet to gather data from and run remaining functions.


Dim wksFileName As String

SelectWorksheet:
Dim dlg As Office.FileDialog
    
    Set dlg = Application.FileDialog(msoFileDialogOpen)
    
    With dlg

        .AllowMultiSelect = False
        .InitialFileName = strInitDlgPath
        .Title = "Select Workbook to Import From"
        .Filters.Clear
        .Filters.Add "Excel Spreadsheets", "*.xls*"
        
        If .Show Then
            wksFileName = .SelectedItems(1)
        Else
            wksFileName = ""
        End If
    End With


'Loop until valid workbook has been selected; will prompt user to try again if invalid or no workbook has been selected
If wksFileName = "" Then                        'Means that user did not select a file.  Maybe wants to cancel?
    response = MsgBox("Worksheet not selected.  Try again?", vbCritical + vbYesNoCancel, "Worksheet not selected")
    If response = vbYes Then
        GoTo SelectWorksheet
    Else
        MsgBox "Import Cancelled", vbInformation + vbOKOnly, "Import Cancelled"
            'Cannot continue ... exit
        Exit Function
    End If
ElseIf FileExists(wksFileName) = False Then     'Check to see if selected file actually exists (in case user manually types a filename in the box rather than selecting from the list)
    response = MsgBox("Selected file does not exist.  Try again?", vbCritical + vbYesNoCancel, "File not found")
    If response = vbYes Then
        GoTo SelectWorksheet
    Else
        MsgBox "Import Cancelled", vbInformation + vbOKOnly, "Import Cancelled"
    End If

Else
    'MsgBox "File found: " & wksFileName, vbInformation + vbOKOnly, "File found"
    
    'Save the directory in the registry for later use ...
    
    For i = Len(wksFileName) To 1 Step -1
        If Mid(wksFileName, i, 1) = "\" Then
            Debug.Print Mid(wksFileName, 1, i - 1)
            SaveSetting "Forecast Importer", "Variables", "Defaultpath", Mid(wksFileName, 1, i - 1)
            Exit For
        End If
    Next i
    
    
    Excel.Application.DisplayAlerts = False         'Don't display alerts ...
    Set wbkForecast = Workbooks.Open(wksFileName, , True)           'Opens selected workbook in READ-ONLY mode so there are no changes made to it!
    GetSourceData
    
    wbkForecast.Close               'Close the source (selected) workbook
    'Don't display alerts ...
    Excel.Application.DisplayAlerts = True          'Turn alerts back on
    
    Set wbkForecast = Nothing       'Dispose object
    wksFileName = ""                'Clear filename
    
    
    
    If ALLOW_MODIFY_WITHOUT_WARNING = True Then
        'User has already turned off modification warning; don't worry about setting it again
        PopulateMasterSpreadsheet
    
    Else
        'Turn off modification warning!
        ALLOW_MODIFY_WITHOUT_WARNING = True
    
        PopulateMasterSpreadsheet
    
        'Turn on modification warning!
        ALLOW_MODIFY_WITHOUT_WARNING = False
    
    End If
        
    
    Exit Function
End If

End Function


Private Function GetSourceData()
'Purpose: Gather all of the data from the source (selected) worksheet


Dim strRangeToUse As String, iNumRecords As Integer



Set wksForecast = wbkForecast.Sheets("Projects")        'Selects the SOURCE worksheet.  The name of this tab must not change or will need to be updated!  (Current tab name: Projects)

iNumRecords = 0         'Initialize
ReDim arrProjectName(iNumRecords): ReDim arrAccountingCode(iNumRecords): ReDim arrStatus(iNumRecords)
ReDim arrEntity(iNumRecords): ReDim arrMileage(iNumRecords): ReDim arrTotals(iNumRecords)

arrOtherData(0) = wksForecast.Range("H6").Value     'Name
arrOtherData(1) = wksForecast.Range("H8").Value      'Position
arrOtherData(2) = wksForecast.Range("P6").Value      'Company


strRangeToUse = "AJ16"  'Initialize

Do Until strRangeToUse = "AJ47"              'Loop until cell A46 has been checked
    If wksForecast.Range(strRangeToUse).Value <> "" And wksForecast.Range(strRangeToUse).Value <> 0 Then
        ReDim Preserve arrProjectName(iNumRecords): ReDim Preserve arrAccountingCode(iNumRecords): ReDim Preserve arrStatus(iNumRecords)
        ReDim Preserve arrEntity(iNumRecords): ReDim Preserve arrMileage(iNumRecords): ReDim Preserve arrTotals(iNumRecords)
        
        arrTotals(iNumRecords) = wksForecast.Range(strRangeToUse).Value                 'AJxx' (Totals)
        strRangeToUse = "A" & Mid(strRangeToUse, 3)
        arrProjectName(iNumRecords) = wksForecast.Range(strRangeToUse).Value            'Axx' (Project Name)
        strRangeToUse = "B" & Mid(strRangeToUse, 2)
        arrAccountingCode(iNumRecords) = wksForecast.Range(strRangeToUse).Value         'Bxx' (Accounting Code)
        strRangeToUse = "C" & Mid(strRangeToUse, 2)
        
        On Error Resume Next        'Set errors to continue
        arrStatus(iNumRecords) = wksForecast.Range(strRangeToUse).Value                 'Cxx' (Status)
        If Err.Number = 13 Then                                                         'Will error if value is NOT a string!  #N/A is not a string.
            'Err # 13 = Type Mismatch
            arrStatus(iNumRecords) = "UNKNOWN"
            Err.Clear
        ElseIf Err.Number > 0 Then
            arrStatus(iNumRecords) = "UNKNOWN"
            MsgBox "An error occurred while retrieving status", vbOKOnly + vbCritical, "An error occurred"
            Err.Clear
        End If
        
        On Error GoTo 0             'Reset error jump
        strRangeToUse = "D" & Mid(strRangeToUse, 2)
        arrEntity(iNumRecords) = wksForecast.Range(strRangeToUse).Value                 'Dxx' (Entity)
        strRangeToUse = "E" & Mid(strRangeToUse, 2)
        arrMileage(iNumRecords) = wksForecast.Range(strRangeToUse).Value                'Exx' (Mileage)
        
        strRangeToUse = "AJ" & Trim(Str(Val(Mid(strRangeToUse, 2)) + 1))
        iNumRecords = iNumRecords + 1
    Else
        strRangeToUse = "AJ" & Trim(Str(Val(Mid(strRangeToUse, 3)) + 1))
    End If

Loop

End Function

Private Function PopulateMasterSpreadsheet()
'Purpose: Populate the current MASTER worksheet of the MASTER workbook with the collected data and apply basic formatting to the cells.


Dim strRangeToUse As String, iCounter As Integer, iNumRecords As Integer, strCompanyToUse As String


strRangeToUse = "A1"        'Initialize
'Find the next free cell to use . . .


'If there is no data in the MASTER worksheet, it will start entering data on line A4 ... this can be changed by expliciting telling it where to start (after this loop statement) if cells A1 through A4
'are empty ... not sure if this would be the intended functionality.  Otherwise, it will start on the 4th free cell if there is data already on the sheet.

'NOTE: The MASTER worksheet should not be "modified" by the user to remove a row of data and leaving an additional blank row ... this could cause existing data to be overwritten by the script

Do Until iCounter >= NUM_BLANK_ROWS_TO_CHECK      'Check for x consecutive blank cells (Column A) and start entering data on the xth free cell.  Modify this constant as necessary.
    If wksMaster.Range(strRangeToUse).Value <> "" Then
        iCounter = 0
    Else
        iCounter = iCounter + 1
    End If

    strRangeToUse = "A" & Trim(Str(Val(Mid(strRangeToUse, 2)) + 1))
Loop

strRangeToUse = "A" & Trim(Str(Val(Mid(strRangeToUse, 2)) - 1))
wksMaster.Range(strRangeToUse).Value = "NAME"                           'User Name Label
wksMaster.Range(strRangeToUse).Font.Bold = True
wksMaster.Range(strRangeToUse).Cells.HorizontalAlignment = xlLeft

strRangeToUse = "B" & Mid(strRangeToUse, 2)
wksMaster.Range(strRangeToUse).Value = "COMPANY"                        'Company Name Label
wksMaster.Range(strRangeToUse).Font.Bold = True
wksMaster.Range(strRangeToUse).Cells.HorizontalAlignment = xlLeft

strRangeToUse = "C" & Mid(strRangeToUse, 2)
wksMaster.Range(strRangeToUse).Value = "POSITION"                       'Position Label
wksMaster.Range(strRangeToUse).Font.Bold = True
wksMaster.Range(strRangeToUse).Cells.HorizontalAlignment = xlLeft

strRangeToUse = "D" & Mid(strRangeToUse, 2)
wksMaster.Range(strRangeToUse).Value = "PROJECT NAME"                   'Project Name Label
wksMaster.Range(strRangeToUse).Font.Bold = True
wksMaster.Range(strRangeToUse).Cells.HorizontalAlignment = xlLeft

strRangeToUse = "E" & Mid(strRangeToUse, 2)
wksMaster.Range(strRangeToUse).Value = "ACCOUNTING CODE"                'Accounting Code Label
wksMaster.Range(strRangeToUse).Font.Bold = True
wksMaster.Range(strRangeToUse).Cells.HorizontalAlignment = xlLeft

strRangeToUse = "F" & Mid(strRangeToUse, 2)
wksMaster.Range(strRangeToUse).Value = "STATUS"                         'Status Label
wksMaster.Range(strRangeToUse).Font.Bold = True
wksMaster.Range(strRangeToUse).Cells.HorizontalAlignment = xlCenter

strRangeToUse = "G" & Mid(strRangeToUse, 2)
wksMaster.Range(strRangeToUse).Value = "ENTITY"                         'Entity Label
wksMaster.Range(strRangeToUse).Font.Bold = True
wksMaster.Range(strRangeToUse).Cells.HorizontalAlignment = xlCenter

strRangeToUse = "H" & Mid(strRangeToUse, 2)
wksMaster.Range(strRangeToUse).Value = "MILEAGE"                        'Mileage Label
wksMaster.Range(strRangeToUse).Font.Bold = True
wksMaster.Range(strRangeToUse).Cells.HorizontalAlignment = xlCenter

strRangeToUse = "I" & Mid(strRangeToUse, 2)
wksMaster.Range(strRangeToUse).Value = "TOTALS"                         'Totals Label
wksMaster.Range(strRangeToUse).Font.Bold = True
wksMaster.Range(strRangeToUse).Cells.HorizontalAlignment = xlCenter



strRangeToUse = "A" & Trim(Str(Val(Mid(strRangeToUse, 2)) + 1))         'Initialize for data entry


For i = 0 To UBound(arrProjectName())

    wksMaster.Range(strRangeToUse).Value = arrOtherData(0)          'User Name
    wksMaster.Range(strRangeToUse).Font.Bold = False
    wksMaster.Range(strRangeToUse).HorizontalAlignment = xlLeft
    
    strRangeToUse = "B" & Mid(strRangeToUse, 2)
    strCompanyToUse = arrOtherData(2)                               'Company Name
    For x = 1 To Len(arrOtherData(2))
        If Mid(arrOtherData(2), x, 1) = " " Then
                strCompanyToUse = Mid(arrOtherData(2), 1, x - 1)
            Exit For
        End If
    Next x
    
    wksMaster.Range(strRangeToUse).Value = strCompanyToUse          'Company Name
    wksMaster.Range(strRangeToUse).Font.Bold = False
    wksMaster.Range(strRangeToUse).HorizontalAlignment = xlLeft
    
    strRangeToUse = "C" & Mid(strRangeToUse, 2)
    wksMaster.Range(strRangeToUse).Value = arrOtherData(1)          'Position
    wksMaster.Range(strRangeToUse).Font.Bold = False
    wksMaster.Range(strRangeToUse).HorizontalAlignment = xlLeft
    
    strRangeToUse = "D" & Mid(strRangeToUse, 2)
    wksMaster.Range(strRangeToUse).Value = arrProjectName(i)        'Project Name
    wksMaster.Range(strRangeToUse).Font.Bold = False
    wksMaster.Range(strRangeToUse).HorizontalAlignment = xlLeft
    
    strRangeToUse = "E" & Mid(strRangeToUse, 2)
    wksMaster.Range(strRangeToUse).Value = arrAccountingCode(i)     'Accounting Code
    wksMaster.Range(strRangeToUse).Font.Bold = False
    wksMaster.Range(strRangeToUse).HorizontalAlignment = xlLeft
    
    strRangeToUse = "F" & Mid(strRangeToUse, 2)
    wksMaster.Range(strRangeToUse).Value = arrStatus(i)             'Status
    wksMaster.Range(strRangeToUse).Font.Bold = False
    wksMaster.Range(strRangeToUse).HorizontalAlignment = xlLeft
    
    strRangeToUse = "G" & Mid(strRangeToUse, 2)
    wksMaster.Range(strRangeToUse).Value = arrEntity(i)             'Entity
    wksMaster.Range(strRangeToUse).Font.Bold = False
    wksMaster.Range(strRangeToUse).HorizontalAlignment = xlLeft
    
    strRangeToUse = "H" & Mid(strRangeToUse, 2)
    wksMaster.Range(strRangeToUse).Value = arrMileage(i)            'Mileage
    wksMaster.Range(strRangeToUse).Font.Bold = False
    wksMaster.Range(strRangeToUse).HorizontalAlignment = xlCenter

    strRangeToUse = "I" & Mid(strRangeToUse, 2)
    wksMaster.Range(strRangeToUse).Value = arrTotals(i)             'Totals
    wksMaster.Range(strRangeToUse).Font.Bold = False
    wksMaster.Range(strRangeToUse).HorizontalAlignment = xlRight
    wksMaster.Range(strRangeToUse).NumberFormat = "$#,##0.00"
    
    strRangeToUse = "A" & Trim(Str(Val(Mid(strRangeToUse, 2)) + 1))     'Initialize for next entry
Next i


'Re-size all cells . . .
wksMaster.Cells.Select
wksMaster.Cells.EntireColumn.AutoFit

wksMaster.Cells("3", "A").Select                                            'After import leave cursor in cell A3 so entire sheet is not "selected"

MsgBox "Import Complete!", vbInformation + vbOKOnly, "Import Complete"



End Function

Private Sub CommandButton1_Click()

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If ALLOW_MODIFY_WITHOUT_WARNING = False Then
    response = MsgBox("If you modify this worksheet, be careful not to leave additional blank lines between data entries (currently set to " & Trim(Str(NUM_BLANK_ROWS_TO_CHECK - 1)) & " blank rows) or the Import macro may overwrite existing data!  Disable modification warning?", vbCritical + vbYesNo, "Modification Warning")
    If response = vbYes Then ALLOW_MODIFY_WITHOUT_WARNING = True
End If

End Sub

Open in new window

Compile-Error.png
Comment
Watch Question

Try adding a reference (Tools/References in the VBA editor) to the Microsoft Scripting Library and see if that corrects the problem.

HainKurtSr. System Analyst
CERTIFIED EXPERT

Commented:
use

if dir(wksFileName) <> "" Then ...

or

Set fs = CreateObject("Scripting.FileSystemObject")
If fs.fileexists(wksFileName) Then ...

Author

Commented:
Here are the ones that have a check mark: I didnt see the "Microsoft Scripting Library"

1. Visual Basic for Applicatoins
2. Microsoft Excel 12.0 Object Library
3.OLE Automation
4. Microsoft office 12.0 Object Library
5. Microsoft Forms 2.0 Object Library
6. Microsoft Script Control 1.0
7. Microsoft Scripting Runtime
8. Microsoft Scriptlet Library

Author

Commented:
OK, I updated line 65 with HainKurts "if dir(wksFileName) <> "" Then". I saved it and ran and now I get a compile error "Block If without End If" on Line 119
Sorry - I meant #7 (runtime instead of library).  FileExists is contained within that library, so I'm not sure why it doesn't know what that function is.  
HainKurtSr. System Analyst
CERTIFIED EXPERT

Commented:
try: Line 65

ElseIf FileExists(wksFileName) = False Then
-->
ElseIf dir(wksFileName) = "" Then

Author

Commented:
Please forgive my lack of knowledge, but I am uncertain how to exactly enter the code you provided. When I try, I get a compile error at (wksFileName).

Could you provide a little clearer example for a moron? Thanks for your patience.
HainKurtSr. System Analyst
CERTIFIED EXPERT

Commented:
on line 65

FileExists(wksFileName) = False

--> replace this with

dir(wksFileName) = ""
HainKurtSr. System Analyst
CERTIFIED EXPERT

Commented:
or add this to line 54

Set fs = CreateObject("Scripting.FileSystemObject")

then add "fs." in front of FileExists on Line 65

ElseIf fs.FileExists(wksFileName) = False Then  ...
Sr. System Analyst
CERTIFIED EXPERT
Commented:
maybe we neeed to define fs first (fix to above post)
or add this to line 54

Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")

then add "fs." in front of FileExists on Line 65

ElseIf fs.FileExists(wksFileName) = False Then  ...
just a wild shot - are ANY of the entries which are displayed when you click on

Tools/References in the VBA editor

marked as MISSING  ?

AW

Author

Commented:
Works! Thank you very much for the assitance!

Explore More ContentExplore courses, solutions, and other research materials related to this topic.