Avatar of fatalblitz
fatalblitz
 asked on

Formatting Excel columns before importing to Access using VBA

I currently have VBA code that imports multiple .xls files located in a single folder into my Microsoft Access database. Before doing so, there is a portion of code that prepares the excel files (changes column names to match field names within database, searches for date columns equaling '00/00/000' and "None" values and changes them to blank " ". This is further noted in the code's comments down below. However, the code doesn't seem to work 100% and we still have to manually go back into the .xls files and do a find and replace for these Date columns that have "00/00/0000" and "None" values and replace with " ". Any suggestions as to how to update this code to remove this manual step? (highlighted in bold) Thanks




'This will prepare the excel files before importing to the database
'It will change the column names to match the field names within the database
'It will also search through the Dates columns for values such as '00/00/0000', "None" so
'that the files will import correctly
Public Function UpdateAndImport(filePath As String, file As String, workItem As Integer)
 '   Late Binding (Needs no reference set)
    Dim oXL As Object
    Dim oExcel As Object
    Dim sFullPath As String
    Dim sPath As String
    Dim TableToImport As String    'Table name within Access Database
    Dim xWs As String   'This will hold the name for the excel worksheet
    Dim xWs2 As String  'This will hold the name for the excel worksheet
    Dim upDatei As Long 'This is used in the system status progress bar
    Dim SysProg As String 'This is used in the system status bar as the message
    upDatei = 0
   
    '===============================
    'Variables used within: FIX WORKBOOK CONTENTS
        Dim count As Integer
        Dim SColumn As Integer
        Dim Scolumn2 As String
        Dim LastRow As Integer
        Dim ColumnName As String
        Dim x As Integer
        Dim i As Integer
    '================================
   
    xWs = "Format"    'Worksheet name for import
    xWs2 = "Sheet1"   'The Data Entry Dates have the worksheet name as Sheet1
   
    ' Create a new Excel instance
    Set oXL = CreateObject("Excel.Application")
     
     
    ' Only XL 97 supports UserControl Property
    On Error Resume Next
    oXL.UserControl = True
    On Error GoTo 0
     
    ' Full path of excel file to open
    sFullPath = filePath & file
    'When Visible is true it will show the excel program.  Uncomment this for testing
    'oXL.Visible = True
   
     On Error GoTo ErrHandle
    'This will open the file
    oXL.workbooks.Open (sFullPath)
    Dim objworkbook As Object
    Set objworkbook = oXL.Application.ActiveWorkbook
       
    'Update Status in text
    [Forms]![Form: Skill Area Selection]![MsgTxt] = "Editing File: " & file
    SysProg = SysCmd(acSysCmdInitMeter, "Editing File: " & file, upDatei)
    'Change workbook column headings depending on which worksheet it is
    'This will set the names of the database table
    If workItem = 1 Then
        TableToImport = "Qualifications Overview"
        DoCmd.OpenForm "FieldInfo", acDesign, , , acFormPropertySettings, acHidden
        'The following lines will change the worksheet field headers (The individual column names)
        objworkbook.worksheets(xWs).range("A1") = [Forms]![FieldInfo]![Text0].DefaultValue
        objworkbook.worksheets(xWs).range("B1") = [Forms]![FieldInfo]![Text6].DefaultValue
        objworkbook.worksheets(xWs).range("C1") = [Forms]![FieldInfo]![Text8].DefaultValue
        objworkbook.worksheets(xWs).range("D1") = [Forms]![FieldInfo]![Text10].DefaultValue
        objworkbook.worksheets(xWs).range("E1") = [Forms]![FieldInfo]![Text12].DefaultValue
        objworkbook.worksheets(xWs).range("F1") = [Forms]![FieldInfo]![Text14].DefaultValue
        objworkbook.worksheets(xWs).range("G1") = [Forms]![FieldInfo]![Text19].DefaultValue
        objworkbook.worksheets(xWs).range("H1") = [Forms]![FieldInfo]![Text21].DefaultValue
        objworkbook.worksheets(xWs).range("I1") = [Forms]![FieldInfo]![Text23].DefaultValue
        objworkbook.worksheets(xWs).range("J1") = [Forms]![FieldInfo]![Text25].DefaultValue
        objworkbook.worksheets(xWs).range("K1") = [Forms]![FieldInfo]![Text27].DefaultValue
        DoCmd.Close acForm, "FieldInfo"
        '========================================================================
        'FIX WORK BOOK CONTENTS
        'This will fix the workbook contents ie. the '00/00/000' , 'none' within this workbook

        i = 1
       
        ColumnName = "Qualification End Date"
        LastRow = objworkbook.worksheets(objworkbook.activesheet.name).UsedRange.Rows.count
           
           
        Do While i <= 3
           
           
            'The x within this do while loop is used to go through each column to find the string within the
            'following column name: Qualification End Date, Qualification Start date, and
            'Qualification Changed Date
            x = 1
            Do While x <= objworkbook.worksheets(objworkbook.activesheet.name).UsedRange.Columns.count
               
                'SColumn = oXL.Application.worksheetfunction.match(ColumnName, objworkbook.worksheet.range(ColumnNumbToLet(x) & "1:" & ColumnNumbToLet(x)"1" & LastRow), 0)
                On Error Resume Next
                'This looks at the current heading (first row) and if it does not matches any of the
                'Column names it will add 1 to x to search for the next column
                If objworkbook.worksheets(objworkbook.activesheet.name).range(ColumnNumbToLet(x) & "1").Value <> ColumnName Then
                    x = x + 1
                'If the column name does match process the following
                Else
           
           
                    SColumn = x  'This is the column number for the found column name
                        '==========================
                        'Excel Find function could not work
                        'With Sheets(ActiveSheet.name).Range("A1:K11")
                        'SColumn = Range("A1:K100").Find(ColumnName, Range("A1"), xlValues, xlWhole, xlByColumns, xlNext).Column
                        'End With
                        '=============================
                       
                        'This will go through all cells within the found column to change any
                        'cells that have the value: '00/00/0000' or 'None'
                        count = 1
                        'This will convert the number column to a letter column
                        Scolumn2 = ColumnNumbToLet(SColumn)
                        Do While count <= LastRow
                            If objworkbook.worksheets(objworkbook.activesheet.name).range(Scolumn2 & count).Value = "00/00/0000" Then
                               objworkbook.worksheets(objworkbook.activesheet.name).range(ColumnNumbToLet(SColumn) & count).Value = ""
                            ElseIf objworkbook.worksheets(objworkbook.activesheet.name).range(Scolumn2 & count).Value = "None" Then
                                objworkbook.worksheets(objworkbook.activesheet.name).range(ColumnNumbToLet(SColumn) & count).Value = ""
                            End If
                            count = count + 1
                        Loop
               
                x = x + 1
                End If
           
            Loop 'End loop for x
           
        'Search for the next column for the belowed strings
        ColumnName = "Qualification Changed Date"
       
        If i = 2 Then ColumnName = "Qualification Start Date"
        i = i + 1
        Loop
        'END of fix for 00/00/00 and 'none'
Microsoft AccessVisual Basic ClassicMicrosoft ExcelMicrosoft Development

Avatar of undefined
Last Comment
fatalblitz

8/22/2022 - Mon
harfang

I must admit: I haven't examined your code in detail to understand what it does. Some used functions are not included and the syntax seems needlessly convoluted, for example:

    objworkbook.worksheets(objworkbook.ActiveSheet.Name).UsedRange.Rows.Count

can be replaced by

    objworkbook.ActiveSheet.UsedRange.Rows.Count

Incidentally, your code would also become more readable using the With construct or object variables for sheets and ranges.

If your aim is simply to find and replace all occurrences of “00/00/0000” and “None”, the following might suffice:

    Dim rngC As Range
    
    For Each rngC In objworkbook.ActiveSheet.UsedRange.Cells
        If rngC = "00/00/0000" Then
            rngC = Empty
        ElseIf rngC = "None" Then
            rngC = Empty
        End If
    Next rngC

Open in new window

I hope this helps
(°v°)
fatalblitz

ASKER
Would I have to comment out or remove the current do while / count code before adding your portion of the code? Sorry my coding knowledge in VBA is fairly basic, I get a compile error: User-defined type not defined and it points to the:

Dim rngC As Range
aikimark

@fatalblitz

The harfang code assumes you have a reference to Microsoft Excel in your Access code.  That is why "Range" is an unknown data type.
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
ASKER CERTIFIED SOLUTION
harfang

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
fatalblitz

ASKER
Okay thanks, I will try this and post back the results!