Opening and Modifying Excel with Access VBA

[eaddi]

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

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

<tbody>
</tbody>

 

[Norie]

Like I mentioned previously things like ActiveCell aren't recognised in Access VBA.

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

 

[xenou]

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.

 

[eaddi]

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

 

[Norie]

What are you searching for here?

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

 

[eaddi]

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

 

[Norie]

Still not 100% sure what you want to do with the Excel workbook but try this.

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

 

[eaddi]

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

Header1	Header2	Header3	Header4	Header5
5/14/2018	5000	Magic Tv	West	N/a
5/14/2018	10000	Magic Tv	East	N/a
5/14/2018	2000	Magic Tv	South	N/a
5/14/2018	600	Magic Tv	North	N/a
5/13/2018	1500	Magic Tv	West	N/a
5/13/2018	900	Magic Tv	East	N/a
5/13/2018	1260	Magic Tv	South	N/a
5/13/2018	15000	Magic Tv	North	N/a
5/13/2018	0	Magic Tv	West	N/a
SHeader1	SHeader2	SHeader3	SHeader4	SHeader5	SHeader6	SHeader7	SHeader8	SHeader9
5/14/2018	200	Johnson	Pack001	West	Incoming	Taxable	30 days	N
5/14/2018	300	Smith	Pack03	North	Referral	Taxable	30 days	N
5/14/2018	500	Longbottom	Pack03	East	Incoming	Taxable	30 days	N
5/14/2018	150	Clark	Pack001	South	Incoming	Taxable	30 days	N
5/14/2018	-890	Fox	Pack001	West	Incoming	Notaxable	30 days	Y
5/14/2018	2000	James	Pack03	North	Incoming	Taxable	90 days	N
5/14/2018	500	Black	Pack001	North	Incoming	Taxable	30 days	N
5/14/2018	600	Whilken	Pack03	East	Referral	Taxable	30 days	N

<colgroup><col width="70" style="width: 53pt;" span="9"> <tbody> </tbody>

 

[Norie]

Is it rows or columns you are deleting?

 

[eaddi]

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

 

[Norie]

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?