Opening and Modifying Excel with Access VBA

E

eaddi

New Member
Joined
Apr 2, 2012
Messages
24
Hello

I am trying to open and modify an Excel 2016 file using VBA in Access 2016. I pieced together the code below, but I keep getting "Compile Error: Sub or Function not defined" at the bolded section of the code below. Does anyone know how to correct this error or if there is a better code to use?

Thanks in advance

[TABLE="width: 500"]
<tbody>[TR]
[TD]


Sub OpenFileWithShell()
Dim Shex As Variant
Dim strPath As String
Dim strFileName As String
Dim strFileType As String
Dim strApplication As String
Dim xRow As Integer
Dim strSearch As String


strPath = "D:\Source Files" & ""
strFileName = "Inventory.xls"
strFileType = Mid(strFileName, InStrRev(strFileName, "."))

Select Case strFileType 'Identify type of file and set application to use
Case ".xls"
strApplication = "Excel.exe " 'Note the trailing space
Case ".docx"
strApplication = "Winword.exe " 'Note the trailing space
End Select

'Enclose path and filename in double quotes in case of spaces (previously omitted)
VarMyFile = Shell(strApplication & Chr(34) & strPath & strFileName & Chr(34), vbNormalFocus)

' UserForm1.Show vbModeless 'Open as modeless if access to workheet is required.

strSearch = "Provision Date"
' Assuming Total is in column C as your picture shows, but you can configure to search anywhere

xRow = Range("A" & Rows.Count).End(xlUp).Row
Range("$A1:A" & xRow).Select

Selection.Find(What:=strSearch, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select

Range("A1:A" & ActiveCell.Row - 1).EntireRow.Delete

Cells.Select
Selection.UnMerge
Range("D:E,H:H,K:K,L:L").Select
Range("L1").Activate
Selection.Delete Shift:=xlToLeft
Range("A1").Select
ActiveWorkbook.Save
ActiveWindow.Close

End Sub

[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Sort by date Sort by votes
Like I mentioned previously things like ActiveCell aren't recognised in Access VBA.

What, in words, do you want the code to do?
 
Upvote 0

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
strSearch is not defined anywhere. I don't even think this would work in Excel anymore. If you can start with a template that does not need this code to run at all that would be best.
 
Upvote 0
I have a database that will be turned over shortly for automation. Before I can submit it I need the Database (using vba) to open an excel file, delete the Data Summary which appears before the data I need to import into the database.

Everything must be completed (modifying, importing, running queries, and exporting tables) from a single macro in access.

I got a little further in the code, but hit a block again. I selected the MircoSoft Excel Object Library for Access and defined my range. Now I am stuck at the bold section.

Sub DeleteXLLines()
Dim Myexcel As Object
Dim Myworkbook As Object
Dim Mysheet As Object
Dim MyFile As String
Dim MyRange As Excel.Range



MyFile = "D:\Source_Files\TROG Server Inventory.xls"
Set Myexcel = CreateObject("Excel.Application")
Set Myworkbook = Myexcel.Workbooks.Open(MyFile)
Set Mysheet = Myworkbook.sheets("TROG Server Inventory")
'Set MyRange = Mysheet.Range("A:M")
Set MyRange = Mysheet.Range("A1:" & Mysheet.Range("A" & Rows.Count).End(xlUp).Address)
Set MyRows = MyRows.Range("A" & Rows.Count).End(xlUp)

MyRange.Find ("Provision Date")
MyRange.Rows("A" & Rows.Count).End(xlUp).Row
MyRange.Rows("$A1:A" & xRow).Select
MyRange.Find(What:=strSearch, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
MyRange2.Rows("A1:A" & ActiveCell.Row - 1).EntireRow.Delete
MyRange.Columns.Select
MyRange.Columns.UnMerge
MyRange.Columns("D:E,H:H,K:K,L:L").Select
MyRange.Cell("L1").Activate
MyRange.Delete Shift:=xlToLeft
Myworkbook.Close True
Set Mysheet = Nothing
Set Myworkbook = Nothing
Set Myexcel = Nothing

End Sub
 
Upvote 0
What are you searching for here?
Code: 
MyRange.Find(What:=strSearch, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
 
Upvote 0
I assigned strSearch as "Provision Date" and made the underlined changes, now my error is "Without Next"


Sub DeleteXLLines()
Dim Myexcel As Object
Dim Myworkbook As Object
Dim Mysheet As Object
Dim MyFile As String
Dim MyRange As Excel.Range
Dim RD As Long
Dim strSearch As String



MyFile = "D:\Source_Files\Inventory.xls"
Set Myexcel = CreateObject("Excel.Application")
Set Myworkbook = Myexcel.Workbooks.Open(MyFile)
Set Mysheet = Myworkbook.Sheets("Inventory")
'Set MyRange = Mysheet.Range("A:M")
Set MyRange = Mysheet.Range("A1:" & Mysheet.Range("A" & Rows.Count).End(xlUp).Address)
For RD = Range("A" & Rows.Count).End(xlUp).Rows To 2 Step -1
strSearch = "Provision Date"

MyRange.Cells("A" & Rows.Count).End(xlUp).Row
MyRange.Cells("$A1:A" & xRow).Select
MyRange.Find(What:=strSearch, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select


MyRange.Rows("A1:A" & ActiveCell.Row - 1).EntireRow.Delete
MyRange.Columns.Select
MyRange.Columns.UnMerge
MyRange.Columns("D:E,H:H,K:K,L:L").Select
MyRange.Cell("L1").Activate
MyRange.Delete Shift:=xlToLeft
Myworkbook.Close True
Set Mysheet = Nothing
Set Myworkbook = Nothing
Set Myexcel = Nothing

End Sub
 
Upvote 0
Still not 100% sure what you want to do with the Excel workbook but try this.
Code: 
Option Explicit

Sub DeleteXLLines()
Dim Myexcel As Object
Dim Myworkbook As Object
Dim Mysheet As Object
Dim RD As Long
Dim MyFile As String
Dim strSearch As String

Const xlUp = -4162
Const xlToLeft = -4159

    MyFile = "D:\Source_Files\Inventory.xls"

    Set Myexcel = CreateObject("Excel.Application")
    Set Myworkbook = Myexcel.Workbooks.Open(MyFile)
    Set Mysheet = Myworkbook.Sheets("Inventory")
    
    With Mysheet
        For RD = Mysheet.Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1
            If .Cells(RD, "A").Value = strSearch Then
                .Rows(RD).Delete
            End If
        Next RD
        .Range("D:E,H:H,K:K,L:L").Delete Shift:=xlToLeft
    End With

    Myworkbook.Close True

    Set Mysheet = Nothing
    Set Myworkbook = Nothing
    Set Myexcel = Nothing

End Sub
 
Upvote 0
What I am trying to do is
1. Delete the Summary section found in the top section of my Excel sheet, since I only need to import everything starting with the S Header row.
2. Some of the columns in the S Header section are merged together, so I need to unmerge them and then delete the empty columns left after unmerging the columns

[TABLE="width: 477"]
<colgroup><col width="70" style="width: 53pt;" span="9"> <tbody>[TR]
[TD="width: 70, bgcolor: transparent"]Header1[/TD]
[TD="width: 70, bgcolor: transparent"]Header2[/TD]
[TD="width: 70, bgcolor: transparent"]Header3[/TD]
[TD="width: 70, bgcolor: transparent"]Header4[/TD]
[TD="width: 70, bgcolor: transparent"]Header5[/TD]
[TD="width: 70, bgcolor: transparent"][/TD]
[TD="width: 70, bgcolor: transparent"][/TD]
[TD="width: 70, bgcolor: transparent"][/TD]
[TD="width: 70, bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/14/2018[/TD]
[TD="bgcolor: transparent, align: right"]5000 [/TD]
[TD="bgcolor: transparent"]Magic Tv[/TD]
[TD="bgcolor: transparent"]West[/TD]
[TD="bgcolor: transparent"]N/a[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/14/2018[/TD]
[TD="bgcolor: transparent, align: right"]10000 [/TD]
[TD="bgcolor: transparent"]Magic Tv[/TD]
[TD="bgcolor: transparent"]East[/TD]
[TD="bgcolor: transparent"]N/a[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/14/2018[/TD]
[TD="bgcolor: transparent, align: right"]2000[/TD]
[TD="bgcolor: transparent"] Magic Tv[/TD]
[TD="bgcolor: transparent"]South[/TD]
[TD="bgcolor: transparent"]N/a[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/14/2018[/TD]
[TD="bgcolor: transparent, align: right"]600[/TD]
[TD="bgcolor: transparent"] Magic Tv[/TD]
[TD="bgcolor: transparent"]North[/TD]
[TD="bgcolor: transparent"]N/a[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/13/2018[/TD]
[TD="bgcolor: transparent, align: right"]1500[/TD]
[TD="bgcolor: transparent"] Magic Tv[/TD]
[TD="bgcolor: transparent"]West[/TD]
[TD="bgcolor: transparent"]N/a[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/13/2018[/TD]
[TD="bgcolor: transparent, align: right"]900[/TD]
[TD="bgcolor: transparent"] Magic Tv[/TD]
[TD="bgcolor: transparent"]East[/TD]
[TD="bgcolor: transparent"]N/a[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/13/2018[/TD]
[TD="bgcolor: transparent, align: right"]1260[/TD]
[TD="bgcolor: transparent"] Magic Tv[/TD]
[TD="bgcolor: transparent"]South[/TD]
[TD="bgcolor: transparent"]N/a[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/13/2018[/TD]
[TD="bgcolor: transparent, align: right"]15000[/TD]
[TD="bgcolor: transparent"] Magic Tv[/TD]
[TD="bgcolor: transparent"]North[/TD]
[TD="bgcolor: transparent"]N/a[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/13/2018[/TD]
[TD="bgcolor: transparent, align: right"]0[/TD]
[TD="bgcolor: transparent"] Magic Tv[/TD]
[TD="bgcolor: transparent"]West[/TD]
[TD="bgcolor: transparent"]N/a[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]SHeader1 [/TD]
[TD="bgcolor: transparent"]SHeader2[/TD]
[TD="bgcolor: transparent"]SHeader3[/TD]
[TD="bgcolor: transparent"]SHeader4[/TD]
[TD="bgcolor: transparent"]SHeader5[/TD]
[TD="bgcolor: transparent"]SHeader6[/TD]
[TD="bgcolor: transparent"]SHeader7[/TD]
[TD="bgcolor: transparent"]SHeader8[/TD]
[TD="bgcolor: transparent"]SHeader9[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/14/2018[/TD]
[TD="bgcolor: transparent, align: right"]200[/TD]
[TD="bgcolor: transparent"]Johnson[/TD]
[TD="bgcolor: transparent"]Pack001[/TD]
[TD="bgcolor: transparent"]West[/TD]
[TD="bgcolor: transparent"]Incoming[/TD]
[TD="bgcolor: transparent"]Taxable[/TD]
[TD="bgcolor: transparent"]30 days[/TD]
[TD="bgcolor: transparent"]N[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/14/2018[/TD]
[TD="bgcolor: transparent, align: right"]300[/TD]
[TD="bgcolor: transparent"]Smith[/TD]
[TD="bgcolor: transparent"]Pack03[/TD]
[TD="bgcolor: transparent"]North[/TD]
[TD="bgcolor: transparent"]Referral[/TD]
[TD="bgcolor: transparent"]Taxable[/TD]
[TD="bgcolor: transparent"]30 days[/TD]
[TD="bgcolor: transparent"]N[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/14/2018[/TD]
[TD="bgcolor: transparent, align: right"]500[/TD]
[TD="bgcolor: transparent"]Longbottom[/TD]
[TD="bgcolor: transparent"]Pack03[/TD]
[TD="bgcolor: transparent"]East[/TD]
[TD="bgcolor: transparent"]Incoming[/TD]
[TD="bgcolor: transparent"]Taxable[/TD]
[TD="bgcolor: transparent"]30 days[/TD]
[TD="bgcolor: transparent"]N[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/14/2018[/TD]
[TD="bgcolor: transparent, align: right"]150[/TD]
[TD="bgcolor: transparent"]Clark[/TD]
[TD="bgcolor: transparent"]Pack001[/TD]
[TD="bgcolor: transparent"]South[/TD]
[TD="bgcolor: transparent"]Incoming[/TD]
[TD="bgcolor: transparent"]Taxable[/TD]
[TD="bgcolor: transparent"]30 days[/TD]
[TD="bgcolor: transparent"]N[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/14/2018[/TD]
[TD="bgcolor: transparent, align: right"]-890[/TD]
[TD="bgcolor: transparent"]Fox[/TD]
[TD="bgcolor: transparent"]Pack001[/TD]
[TD="bgcolor: transparent"]West[/TD]
[TD="bgcolor: transparent"]Incoming[/TD]
[TD="bgcolor: transparent"]Notaxable[/TD]
[TD="bgcolor: transparent"]30 days[/TD]
[TD="bgcolor: transparent"]Y[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/14/2018[/TD]
[TD="bgcolor: transparent, align: right"]2000[/TD]
[TD="bgcolor: transparent"]James[/TD]
[TD="bgcolor: transparent"]Pack03[/TD]
[TD="bgcolor: transparent"]North[/TD]
[TD="bgcolor: transparent"]Incoming[/TD]
[TD="bgcolor: transparent"]Taxable[/TD]
[TD="bgcolor: transparent"]90 days[/TD]
[TD="bgcolor: transparent"]N[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/14/2018[/TD]
[TD="bgcolor: transparent, align: right"]500[/TD]
[TD="bgcolor: transparent"]Black[/TD]
[TD="bgcolor: transparent"]Pack001[/TD]
[TD="bgcolor: transparent"]North[/TD]
[TD="bgcolor: transparent"]Incoming[/TD]
[TD="bgcolor: transparent"]Taxable[/TD]
[TD="bgcolor: transparent"]30 days[/TD]
[TD="bgcolor: transparent"]N[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5/14/2018[/TD]
[TD="bgcolor: transparent, align: right"]600[/TD]
[TD="bgcolor: transparent"]Whilken[/TD]
[TD="bgcolor: transparent"]Pack03[/TD]
[TD="bgcolor: transparent"]East[/TD]
[TD="bgcolor: transparent"]Referral[/TD]
[TD="bgcolor: transparent"]Taxable[/TD]
[TD="bgcolor: transparent"]30 days[/TD]
[TD="bgcolor: transparent"]N[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Is it rows or columns you are deleting?
 
Upvote 0
Both
Step 1 - I need to delete everything above the SHeader row (But the number of rows vary each day. Today could be 20 and tomorrow 25)
Step 2- Then I need to unmerge the data and delete the blank columns left after the unmerge.


This is what I was attempting do with my code. I copied your code and tried to modified it. But it only focuses on column A and doesn't select all rows above SHeader Row so that they can be deleted. Below is my attempt to edit the your code =(.

Sub DeleteXLLinesTest()

Dim Myexcel As Object
Dim Myworkbook As Object
Dim Mysheet As Object
Dim RD As Long
Dim MyFile As String
Dim strSearch As String
Const xlUp = -4162
Const xlToLeft = -4159
MyFile = "D:\Source_Files\TROG Server Inventory2.xls"
Set Myexcel = CreateObject("Excel.Application")
Set Myworkbook = Myexcel.Workbooks.Open(MyFile)
Set Mysheet = Myworkbook.Sheets("TROG Server Inventory")

With Mysheet
For RD = Mysheet.Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1
If .Cells(RD, "A").Value = strSearch Then
.EntireRow(RD).Delete
End If
Next RD
.Range.UnMerge
.Range("D:E,H:H,K:K,L:L").Delete Shift:=xlToLeft
End With

Myworkbook.Save
Myworkbook.Close True
 
Upvote 0
The code I posted will delete entire rows wherever it finds the search term in strSearch in column A.

If you are deleting entire rows above SHeader row how can there be merged cells left?
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
ACCESS, VBA: Fetch data from sql server and paste it into local table.
Replies
3
Views
2K
Micron
M
tjdrake
  • Solved
Multi-User Access DB Table
Replies
3
Views
1K
Micron
M
R
  • Solved
Late Binding: extract Access to Excel with formatting
2 3
Replies
22
Views
4K
roelandwatteeuw
R
S
  • Question Question
MS ACCESS VBA CODE - open up an excel file, copy paste, save and copy file
Replies
1
Views
6K
Colo
Colo
J
  • Solved
VBA Code Not Closing Excel Application
2
Replies
12
Views
4K
JohanGduToit
J

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top