We help IT Professionals succeed at work.

move and delete columns after exporting to excel

Fordraiders
Fordraiders asked
on
access 365
excel 365

Exporting from access to excel. need to move fields after exporting

Function mYExport( _
                     query$, path$, _
                     fileName$, wksName$, _
                     colsCurrency$, colsDate$ _
                     ) As String
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On Error GoTo errHandler
   Dim xlApp As Object, wkbk As Object, wks As Object
   Dim file$
   Dim formatCur$, formatDate$, intColor&
   Dim arrayCols() As String, col$, n%, i%, w!
   Dim cell As Range
   Dim msg$
   ' Worksheet formats
   formatCur$ = "$#,##0_);($#,##0)"
   formatDate$ = "dd-mm-yyyy"
   intColor& = RGB(192, 192, 192)
   ' Create workbook
   file$ = path$ & fileName$
   DoCmd.TransferSpreadsheet _
      TransferType:=acExport, _
      SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
      TableName:=query$, _
      fileName:=file$, _
      HasFieldNames:=True
   ' Open workbook
   Set xlApp = CreateObject("Excel.Application")
   With xlApp
      .Visible = True
      Set wkbk = .Workbooks.Open(file$)
   End With
   ' Format worksheet
   Set wks = wkbk.worksheets(1)
   With wks
      .Name = wksName$
      ' Currency columns
      arrayCols = Split(colsCurrency$, ",")
      For i = LBound(arrayCols) To UBound(arrayCols)
         With .Columns(arrayCols(i))
            .NumberFormat = "$#,##0_);($#,##0)"
         End With
      Next i
      ' Date columns
      arrayCols = Split(colsDate$, ",")
      For i = LBound(arrayCols) To UBound(arrayCols)
         With .Columns(arrayCols(i))
            .NumberFormat = formatDate$
         End With
      Next i
      
      ' Filters
    '  With .Range("A1")
    '     .Select
    '     .autofilter
    '  End With
      
      ' Column width adjustments
      With .Cells
         .Select
         .EntireColumn.AutoFit
      End With
      n% = .Cells(1, 1).End(xlToRight).Column
      For i% = 1 To n%
         With .Cells(1, i%)
            w! = .EntireColumn.ColumnWidth
            .EntireColumn.ColumnWidth = w! + 4
            .HorizontalAlignment = xlCenter
            .Interior.Color = intColor&
            .Font.Bold = True
         End With
      Next i%
   End With
   
   
   ' FREEZE PANES
   With xlApp.ActiveWindow
      .SplitColumn = 0
      .SplitRow = 1
      .FreezePanes = True
   End With
   msg$ = vbNullString
procDone:
   Set wks = Nothing
   Set wkbk = Nothing
   Set xlApp = Nothing
   dmwExport = msg$
   Exit Function
errHandler:
   msg$ = _
      Err.Number & ": " & Err.Description
   Resume procDone
End Function

Open in new window


What I need:

I have columns from A-X

I need to cut and move Column U and V behind Column A

i need to cut and move "Column A" to be after "Column Z"

then remove/delete Column W



Thanks fordraiders
Comment
Watch Question

View Solution Only

HuaMin ChenProblem resolver

Commented:
Hi,
You can also use VBA/VB script to copy the whole sheet with expected columns inside, and then do the export.
Analyst Assistant
Commented:
Try this, I've added the code to move/delete the specified columns after the code that does the currrency/date formatting.
Function mYExport( _
         query$, path$, _
         fileName$, wksName$, _
         colsCurrency$, colsDate$ _
                       ) As String
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    On Error GoTo errHandler
    Dim xlApp As Object, wkbk As Object, wks As Object
    Dim file$
    Dim formatCur$, formatDate$, intColor&
    Dim arrayCols() As String, col$, n%, i%, w!
    Dim cell As Range
    Dim msg$
   
    ' Worksheet formats
    formatCur$ = "$#,##0_);($#,##0)"
    formatDate$ = "dd-mm-yyyy"
    intColor& = RGB(192, 192, 192)
   
    ' Create workbook
    file$ = path$ & fileName$
    '   DoCmd.TransferSpreadsheet _
    '      TransferType:=acExport, _
    '      SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
    '      TableName:=query$, _
    '      fileName:=file$, _
    '      HasFieldNames:=True
    '   ' Open workbook
    Set xlApp = CreateObject("Excel.Application")
   
    With xlApp
        .Visible = True
        Set wkbk = .Workbooks.Open(file$)
    End With
   
    ' Format worksheet
    Set wks = wkbk.Worksheets(1)
   
    With wks
        .Name = wksName$
      
        ' Currency columns
        arrayCols = Split(colsCurrency$, ",")
        For i = LBound(arrayCols) To UBound(arrayCols)
            With .Columns(arrayCols(i))
                .NumberFormat = "$#,##0_);($#,##0)"
            End With
        Next i
      
        ' Date columns
        arrayCols = Split(colsDate$, ",")
        For i = LBound(arrayCols) To UBound(arrayCols)
            With .Columns(arrayCols(i))
                .NumberFormat = formatDate$
            End With
        Next i
      
        .Columns("U:V").Cut
        .Columns("B:B").Insert Shift:=xlToRight
    
        .Columns("A:A").Cut
        .Columns("AA:AA").Insert Shift:=xlToRight
    
        .Columns("W:W").Delete
    
        With .Cells
            .EntireColumn.AutoFit
        End With
      
        n% = .Cells(1, 1).End(xlToRight).Column
      
        For i% = 1 To n%
            With .Cells(1, i%)
                w! = .EntireColumn.ColumnWidth
                .EntireColumn.ColumnWidth = w! + 4
                .HorizontalAlignment = xlCenter
                .Interior.Color = intColor&
                .Font.Bold = True
            End With
        Next i%
    End With
   
   
    ' FREEZE PANES
    With xlApp.ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
        .FreezePanes = True
    End With
   
    msg$ = vbNullString
   
procDone:
    Set wks = Nothing
    Set wkbk = Nothing
    Set xlApp = Nothing
    mYExport = msg$
    Exit Function
   
errHandler:
    msg$ = _
         Err.Number & ": " & Err.Description
    Resume procDone
   
   
End Function

Open in new window

Fabrice LambertConsulting
Distinguished Expert 2017

Commented:

Instead of opening / updating / saving the resulting workbook, why don't you update the source query so only the data you need are exported ?


Or even better, Power BI to the rescue:
Throw this VBA to garbage, Create a new workbook that will query the database.
No more VBA involved, no more troubles.

Fordraiders

Author

Commented:
@Fabrice, Just to answer your question. The Customer is always right. Even though the qryTemp fields are arranged a way on the form. They need the export to be in this format  and look.. I agree wih you but , not my condition or ask.
Fordraiders

Author

Commented:
Thanks very much !!