Open excel file and "clean it up" then import (1 Viewer)

tmyers

Well-known member
Local time
Today, 18:55
Joined
Sep 8, 2020
Messages
1,090
I have code that I have been using to import excel files into my db (curtesy to TheDBGuy), but the time has already come that I need to get even more complicated with it for a better user experience. First few people I have let try the process, have royally messed it up.

The code that I have been using is:
Code:
Public Function ImportXLBF() As Boolean
'thedbguy@gmail.com
'10/9/2020

Dim fd As Object
Dim strFile As String

Set fd = Application.FileDialog(3)
    
With fd
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xls*"
    If .Show Then
        strFile = .SelectedItems(1)
    End If
End With

If strFile = "" Then
    ImportXL = False
Else
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "tblTempBrightFocus", strFile, True
    ImportXL = True
End If

Set fd = Nothing

End Function
This works like a charm, but requires the excel file to be cleaned up a bit before they can imported.

I am wanting the code to do all the cleaning up itself to avoid the human error.

I know the concept, but not how to write it. I would open excel as an object then loop through the rows defining what needs deleted and what needs kept.
I have found things like https://stackoverflow.com/questions/45714842/access-vba-to-open-edit-and-save-excel-docm but this (to me) is pretty complicated and I don't fully understand what all is happening with that code.

Long story short, I am trying to open excel as an object, delete rows, lets say 1-16 (and a floating image as all the files have one), after the rows are deleted, a specific row should now be row 1 (my column headers in Access) then loop through all remaining rows to find a specific word in a certain column (in my case the word would be something like grand total in say column G, then select that row and delete it and everything below it. That would allow the rest of my code to run and import the file with no human interaction on the excel file (minus dropping it on their desktop from their email or something).

I have dealt with looping once or twice, but neither required something so specific.
 

Gasman

Enthusiastic Amateur
Local time
Today, 22:55
Joined
Sep 21, 2011
Messages
14,048
I would record the steps needed in an Excel macro and copy and modify that code.?
 

tmyers

Well-known member
Local time
Today, 18:55
Joined
Sep 8, 2020
Messages
1,090
I would record the steps needed in an Excel macro and copy and modify that code.?
I did think about that. That would work with removing the header from the excel file, but the files themselves vary in length so deleting the footer I dont think would work that way.
 

Gasman

Enthusiastic Amateur
Local time
Today, 22:55
Joined
Sep 21, 2011
Messages
14,048
I did think about that. That would work with removing the header from the excel file, but the files themselves vary in length so deleting the footer I dont think would work that way.
Well it possibly would if you looked for something constant in the footer?
Even then you could just go to the bottom of the sheet and then move back a few rows.?

There is no hard and fast answer as every sheet is different, you have to experiment?
 

tmyers

Well-known member
Local time
Today, 18:55
Joined
Sep 8, 2020
Messages
1,090
The constant would be the "total". I used the macro recorder to get the header deletion. I now just need to start from the bottom of the sheet and loop through until it finds total then select it and delete it plus previous rows.
 

Isaac

Lifelong Learner
Local time
Today, 15:55
Joined
Mar 14, 2017
Messages
8,738
Look for code samples of looping through rows in excel
 

tmyers

Well-known member
Local time
Today, 18:55
Joined
Sep 8, 2020
Messages
1,090
Starting piecing this together, but could use a little input to make sure I am doing it correctly.

Will the below correctly set the workbook to the file selected from the file explorer?

Code:
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim fd As Object
Dim strfile As String

    Set fd = Application.FileDialog(3)
    
        With fd
            .allowmultiselect = False
            .Filters.Clear
            .Filters.Add "Excel Files", "*.xls*"
        If .Show Then
            .strfile = .selecteditems(1)
        End If
        End With
        
    Set xl = New Excel.Application
    Set wb = xl.Workbooks.Open(strfile)
    set ws = wb.Sheets("Sheet0")
 

Gasman

Enthusiastic Amateur
Local time
Today, 22:55
Joined
Sep 21, 2011
Messages
14,048
Looks OK to me, but why not just try it and see.? Easy enough to do?
 

tmyers

Well-known member
Local time
Today, 18:55
Joined
Sep 8, 2020
Messages
1,090
Looks OK to me, but why not just try it and see.? Easy enough to do?
I am trying the method of finding the bottom row and going back up. Is that what you mean?
 

Gasman

Enthusiastic Amateur
Local time
Today, 22:55
Joined
Sep 21, 2011
Messages
14,048
I am trying the method of finding the bottom row and going back up. Is that what you mean?
No, I was referring to the correct file being opened as per the question.
Perhaps look at finding the word "Total" if it is unique?
 

tmyers

Well-known member
Local time
Today, 18:55
Joined
Sep 8, 2020
Messages
1,090
No, I was referring to the correct file being opened as per the question.
Perhaps look at finding the word "Total" if it is unique?
Ah I was thinking too far ahead (sorry its still early).
Yes, that part worked correctly after a few errors being corrected. I have cobbled together code to find the row with that value, but the code to delete is giving me grief. I am trying to fix it.
 

Gasman

Enthusiastic Amateur
Local time
Today, 22:55
Joined
Sep 21, 2011
Messages
14,048
Again, use the macro recorder or Google. That is how I do it. I also do it piece by piece, making sure each part works, before moving on to the next step.
Slow, perhaps, but it works (well, for me at least) :)
 

tmyers

Well-known member
Local time
Today, 18:55
Joined
Sep 8, 2020
Messages
1,090
I cobbled something together, but I messed up the delete portion. Its not returning a valid range. Any ideas?
Code:
Option Compare Database

Public Function FormatSPExcel()

Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim fd As Object
Dim strfile As String
Dim r As Range ' range variable
Dim d As String ' rows to delete variable


    Set fd = Application.FileDialog(3)
    
        With fd
            .allowmultiselect = False
            .Filters.Clear
            .Filters.Add "Excel Files", "*.xls*"
            If .Show Then
                strfile = .selecteditems(1)
            End If
        End With
        
    Set xl = New Excel.Application
    Set wb = xl.Workbooks.Open(strfile)
    Set ws = wb.Sheets("Sheet0")
    
    'deletes and cleans up header
        ws.Shapes.Range(Array("Picture 1")).Select
        Selection.Delete
        Rows("1:21").Select
        Selection.Delete Shift:=xlUp
        
        
    'delete footer up to and including total
    Set r = ws.Range("A:K").Find("Total", lookin:=xlValues)
    
    
    Do While Not r Is Nothing
        d = "A:K" & r.Row + 30
        ws.Range(d).Delete xlShiftUp
        Set r = ws.Range("A:K").Find("Total", lookin:=xlValues)
    Loop
        
        
    wb.Save
    xl.Quit
    Set xl = Nothing
        
    
End Function
 

Gasman

Enthusiastic Amateur
Local time
Today, 22:55
Joined
Sep 21, 2011
Messages
14,048
Not offhand. I'd have to walk through the code line by line.
I would have probably established a start row, then an end row, then just deleted that range.?
 

tmyers

Well-known member
Local time
Today, 18:55
Joined
Sep 8, 2020
Messages
1,090
I am struggling on this one. I can't figure out the right way to write out the delete loop.
 

Gasman

Enthusiastic Amateur
Local time
Today, 22:55
Joined
Sep 21, 2011
Messages
14,048
As I said, it does not need to be a loop?
 

tmyers

Well-known member
Local time
Today, 18:55
Joined
Sep 8, 2020
Messages
1,090
As I said, it does not need to be a loop?
Once again sorry, using incorrect word. I stopped trying to loop and am just trying to find a specific row then delete. I think I am closer now.
 

tmyers

Well-known member
Local time
Today, 18:55
Joined
Sep 8, 2020
Messages
1,090
I think I got it.
Code:
Public Function FormatSPExcel()

Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim fd As Object
Dim strfile As String
Dim r As Range ' range variable
Dim d As String ' rows to delete variable


    Set fd = Application.FileDialog(3)
   
        With fd
            .allowmultiselect = False
            .Filters.Clear
            .Filters.Add "Excel Files", "*.xls*"
            If .Show Then
                strfile = .selecteditems(1)
            End If
        End With
       
    Set xl = New Excel.Application
    Set wb = xl.Workbooks.Open(strfile)
    Set ws = wb.Sheets("Sheet0")
   
    'deletes and cleans up header
        ws.Shapes.Range(Array("Picture 1")).Delete
        'Selection.Delete
        ws.Rows("1:21").Delete
        'Selection.Delete Shift:=xlUp
       
       
    'delete footer up to and including total
    Set r = ws.Range("A:K").Find("Total", lookin:=xlValues)
   
        With ws
            .Rows(r.Row & ":" & .Rows.Count).Delete
        End With
       
    wb.Close True
    Set wb = Nothing
    xl.Quit
    Set xl = Nothing
       
   
End Function
This seems to do what I want. Takes a second or two vs the near instant of the previous code, but that is to be expected. No looping. Just find that one row then delete everything below it. I am noticing that the excel app doesn't seen to close fully. I wonder if I did my clean up incorrectly.
 

Gasman

Enthusiastic Amateur
Local time
Today, 22:55
Joined
Sep 21, 2011
Messages
14,048
Here is how I did it for a Quicken Output to Excel

Code:
'   Find TOTAL field, select extra rows and delete
    Cells.Find(What:="TOTAL ", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Range(ActiveCell.Row & ":" & ActiveCell.Row + 10).Select
    Selection.Delete Shift:=xlUp
 

Pat Hartman

Super Moderator
Staff member
Local time
Today, 18:55
Joined
Feb 19, 2002
Messages
42,976
Why not send the users a properly formatted template? If you allow them to simply do their own thing, you will never have a reliable process since they will simply keep making different errors.
 

Users who are viewing this thread

Top Bottom