VBA Delete Connection to External Data Source & Copy Range into new Worksheet

[JohanGduToit]

Morning MrExcel Experts,

We receive an Excel file containing sales information from a customer on a weekly basis which I need to auto re-format and import into our ERP System. The customer's sales file contain links to a datasource residing on the customer's ERP system, so, when we open the file, a whole lot of messages are displayed indicating that these connections can't be establish.

The reformatting of the file will be a call from within MS Access (not an Excel Macro).

The various steps to import the sales file would be as follow:

(A) Programmatically (with VBA code) delete all data connections from the Excel File

(B) Delete all worksheets, except one specified worksheet name "Sales Info Tab".

(C) On the remaining worksheet "Sales Info Tab", select range of cells from cell "A8" to the last row and column containing data.

(D) Copy the selected range from "Sales Info Tab" into a new worksheet named "SALES".

(E) Delete worksheet "Sales Info Tab"

The rest of the formatting I can manage (deleting of unwanted columns, deleting of the last row which contain totals, etc, etc.) - BUT I need help, specifically with points "A", "C" and "D"...

Any help will be hugely appreciated!!!

 

[JohanGduToit]

Here is what I have so far...

Need assistance where comments state "Insert Code..."

Public Sub FormatWoolworths(sFile As String)

    Const xlUp As Long = -4162
    Const xlToLeft As Long = -4159
    Const xlValues As Long = -4163
    Const xlWhole As Long = 1
    
    Dim wb As Excel.Workbook, ws As Excel.Worksheet
        
    Application.SetOption "Show Status Bar", True
    vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting Woolworths Sales File... Please wait.")
    
    With CreateObject("Excel.Application")
        Set wb = .Workbooks.Open(sFile)
        
        'Insert Code to remove all External Data Connections/-Sources
        
        .Application.DisplayAlerts = False
        For Each ws In wb.Sheets
            If ws.Name <> "Sales Info Tab" Then
                ws.Delete
            End If
        Next ws
        .Application.DisplayAlerts = True
        
        'Insert Code to select Range A8 to Last Row and Column containing data from remaining Worksheet "Sales Infor Tab"
        'Insert Code to copy the selected Range into a new Worksheet named "SALES"
        
        .Application.Sheets("SALES").Select
        .Application.Range("D:D,E:E,G:G,H:H,J:J,K:K,L:L,M:M").Select        'Delete selected Columns
        .Application.Selection.Delete shift:=xlToLeft
        .Application.Columns("G:G").Select                                  'Delete all Columns from Column G to the end (after selected columns above have been deleted)
        .Application.Range(.Application.Selection, .Application.Selection.End(xlToRight)).Select
        '.Application.Selection.Delete shift:=xlToLeft
        '.Application.Rows("1:8").Select                                     'Delete Row 1 to 8
        .Application.Selection.Delete shift:=xlUp
        .Application.Cells(Rows.Count, "A").End(xlUp).EntireRow.Delete      'Delete Last Row
        .Application.Range("A1").Select
        wb.Save
        'wb.Close = True
        Set wb = Nothing
        .Application.Quit
    End With
    vStatusBar = SysCmd(acSysCmdClearStatus)
    
End Sub

 

[JohanGduToit]

Afternoon Experts,

I have managed to get the code working to everything I require, except for programmatically remove all links to external data sources.

Working code below (removal of external data source links still to be added): PLEASE ASSIST

Public Sub FormatWoolworths(sFile As String)

    Const xlUp As Long = -4162
    Const xlToLeft As Long = -4159
    Const xlValues As Long = -4163
    Const xlWhole As Long = 1
    
    Dim wb As Excel.Workbook, ws As Excel.Worksheet
    Dim lastRow, lastColumn As Long
    Dim DataRange As Range
        
    Application.SetOption "Show Status Bar", True
    vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting Woolworths Sales File... Please wait.")
    
    With CreateObject("Excel.Application")
        Set wb = .Workbooks.Open(sFile)
        
        'Insert Code to remove all External Data Connections/-Sources
        
        .Application.DisplayAlerts = False
        For Each ws In wb.Sheets
            If ws.Name <> "Sales Info Tab" Then
                ws.Delete
            End If
        Next ws
        .Application.DisplayAlerts = True
        .Application.Sheets.Add.Name = "SALES"                          'Create New Worksheet
        .Application.Sheets("Sales Info Tab").Select
        lastRow = .Application.ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
        lastColumn = .Application.ActiveSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        .Application.Range(Cells(8, 1), Cells(lastRow - 1, lastColumn)).Select      'lastRow minus 1 to exclude Row containing totals
        .Application.Selection.Copy
        .Application.Sheets("SALES").Select
        .Application.ActiveSheet.Paste
        .Application.Sheets("SALES").Select
        .Application.Range("A:A,B:B,D:D,E:E,G:G,H:H,J:J,K:K,L:L,M:M,O:O,P:P,Q:Q").Select        'Delete selected Columns
        .Application.Selection.Delete shift:=xlToLeft
        .Application.Rows("1:1").Select                                     'Delete 1st Row containg Header Info
        .Application.Selection.Delete shift:=xlUp
        .Application.Range("A1").Select
        wb.Save
        Set wb = Nothing
        .Application.Quit
    End With
    vStatusBar = SysCmd(acSysCmdClearStatus)
    
End Sub

 

[JohanGduToit]

I have managed to get it to work; except for the fact that Excel (when called from the Access application) remain open in the background.

There's a syntax error (maybe a missing dot) somewhere; not sure where... please check?

Latest code:

Public Sub FormatWoolworths(sFile As String)

    Const xlUp As Long = -4162
    Const xlToLeft As Long = -4159
    Const xlValues As Long = -4163
    Const xlWhole As Long = 1
    
    Dim wb As Excel.Workbook, ws As Excel.Worksheet
    Dim lastRow, lastColumn As Long
    Dim DataRange As Range
            
    Application.SetOption "Show Status Bar", True
    vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting Woolworths Sales File... Please wait.")
    
    With CreateObject("Excel.Application")
        Set wb = .Workbooks.Open(sFile)
        .DisplayAlerts = False
        For Each ws In wb.Sheets
            If ws.Name <> "Sales Info Tab" Then
                ws.Delete
            End If
        Next ws
        .DisplayAlerts = True
        .Sheets.Add.Name = "SALES"                                      'Create New Worksheet
        .Sheets("Sales Info Tab").Select
        lastRow = .ActiveSheet.Range("A" & .ActiveSheet.Rows.Count).End(xlUp).Row
        lastColumn = .ActiveSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        .Range(Cells(8, 1), Cells(lastRow - 1, lastColumn)).Select      'lastRow minus 1 to exclude Row containing totals
        .Selection.Copy
        .Sheets("SALES").Select
        .ActiveSheet.Paste
        .Sheets("SALES").Select
        .Range("A:A,B:B,D:D,E:E,G:G,H:H,J:J,K:K,L:L,M:M,O:O,P:P,Q:Q").Select        'Delete selected Columns
        .Selection.Delete shift:=xlToLeft
        .Rows("1:1").Select                                             'Delete 1st Row containg Header Info
        .Selection.Delete shift:=xlUp
        .Range("A1").Select
        wb.Save
        Set wb = Nothing
        .Quit
    End With
    vStatusBar = SysCmd(acSysCmdClearStatus)
    
End Sub

 

[JohanGduToit]

Found the syntax error... missing "." (dots) before "Cells"

.Range(.Cells(8, 1), .Cells(lastRow - 1, lastColumn)).Select      'lastRow minus 1 to exclude Row containing totals

 

[JohanGduToit]

Final working code:

So at the end of the day I managed to figure it out myself

Public Sub FormatWoolworths(sFile As String)

    Const xlUp As Long = -4162
    Const xlToLeft As Long = -4159
    Const xlValues As Long = -4163
    Const xlWhole As Long = 1
    
    Dim wb As Excel.Workbook, ws As Excel.Worksheet
    Dim lastRow, lastColumn As Long
    Dim DataRange As Range
            
    Application.SetOption "Show Status Bar", True
    vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting Woolworths Sales File... Please wait.")
    
    With CreateObject("Excel.Application")
        Set wb = .Workbooks.Open(sFile)
        .DisplayAlerts = False
        For Each ws In wb.Sheets
            If ws.Name <> "Sales Info Tab" Then
                ws.Delete
            End If
        Next ws
        .DisplayAlerts = True
        .Sheets.Add.Name = "SALES"                                      'Create New Worksheet
        .Sheets("Sales Info Tab").Select
        lastRow = .ActiveSheet.Range("A" & .ActiveSheet.Rows.Count).End(xlUp).Row
        lastColumn = .ActiveSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        .Range(.Cells(8, 1), .Cells(lastRow - 1, lastColumn)).Select      'lastRow minus 1 to exclude Row containing totals
        .Selection.Copy
        .Sheets("SALES").Select
        .ActiveSheet.Paste
        .Sheets("SALES").Select
        .Range("A:A,B:B,D:D,E:E,G:G,H:H,J:J,K:K,L:L,M:M,O:O,P:P,Q:Q").Select        'Delete selected Columns
        .Selection.Delete shift:=xlToLeft
        .Rows("1:1").Select                                             'Delete 1st Row containg Header Info
        .Selection.Delete shift:=xlUp
        .Range("A1").Select
        wb.Save
        Set wb = Nothing
        .Quit
    End With
    vStatusBar = SysCmd(acSysCmdClearStatus)
    
End Sub