Export query result to excel with column width and some more changes...VBA?

[A1ex037]

Hello to everyone, I hope that all of you are in good health in these troubled times!

I have a specific problem and I'd appreciate any help that I can get.
I have an Access database and every day a result of specific query (stock level at the warehouse.) is exported to Excel. Due to the complexity of the warehouse, it exports only one segment. One day the query will result with a set of data that has "A" in specific column (in one of the tables), other day "B", and so on (it goes from A to M). The result contains only those items that are on stock at the moment. So, every day I have to edit the query and update the letter for that day (from A to B, B to C, and so on). Export is done by right clicking at the query, and "export to Excel". That leaves me with columns whose width is not fit with the content inside. I need the width of first 3 columns to enough to show the entire content of the cell (not sure if that is "auto width"), format of 4th column should be changed from "general" to "number". Other columns are not important (they may remain as they are). Furthermore, every item in table that describes the item has a checkbox column (active if checked). Export will process both "active" and "inactive" items, but once the export is done, I have to update that checkbox to "active" status (for items that were exported as "inactive"). Having them marked in different color in Excel would also be helpful.
I have been looking at this thread, but I am not sure where and how to start.

Thanks in advance

 

[Isaac]

Ok there are a lot of questions here, but thinking about where to start - what about starting with an Access vba procedure that exports the query to Excel and then does some formatting? If we detect there is some definite pattern/logic/rules to the "which letter do I query today" issue, that could be coded too.

 

[sxschech]

I have code that will do some of what you want, but you will need to experiment and edit parts of it to work with your existing excel layout. I'll see if I can locate and post tomorrow.

 

[A1ex037]

Thank you for your answers. Obviously I don't have enough experience with it. Will start as Isaac suggested, and get back here with progress.

 

[Gasman]

In Excel record a macro to set the column widths as you need.
Then apply that code (slightly modified) to the exported query data.

Also a good code learning experience.?
I would think updating the checkbox in Access would be easier?

 

[The_Doc_Man]

The question is whether you want to set the column widths to a specific number or would you be happy with an AUTOFIT option? Takes less computation on your part if you do that. This little segment I used does the autofit on one column at a time. Some of the columns have to be centered; at least two of them do not/should not be centered. My comment includes "Dumb Excel" because you cannot give it a range of columns and autofit them all at once. Or at least I could not do it. Heck, for all I know it might be "Dumb Doc" - but this is what I was stuck with doing.

    With xgWkSh                             'do things one column at a time (dumb Excel)
   
        .Columns("A").AutoFit
       
        .Columns("B").HorizontalAlignment = xlCenter
        .Columns("B").AutoFit
       
        .Columns("C").HorizontalAlignment = xlCenter
        .Columns("C").AutoFit
       
        .Columns("D").HorizontalAlignment = xlCenter
        .Columns("D").AutoFit
       
        .Columns("E").HorizontalAlignment = xlCenter
        .Columns("E").AutoFit
       
        .Columns("F").HorizontalAlignment = xlCenter
        .Columns("F").AutoFit
       
        .Columns("G").HorizontalAlignment = xlCenter
        .Columns("G").AutoFit
       
        .Columns("H").HorizontalAlignment = xlCenter
        .Columns("H").AutoFit
       
        .Columns("I").AutoFit
       
    End With

 

[Isaac]

The question is whether you want to set the column widths to a specific number or would you be happy with an AUTOFIT option? Takes less computation on your part if you do that. This little segment I used does the autofit on one column at a time. Some of the columns have to be centered; at least two of them do not/should not be centered. My comment includes "Dumb Excel" because you cannot give it a range of columns and autofit them all at once. Or at least I could not do it. Heck, for all I know it might be "Dumb Doc" - but this is what I was stuck with doing.

    With xgWkSh                             'do things one column at a time (dumb Excel)
  
        .Columns("A").AutoFit
      
        .Columns("B").HorizontalAlignment = xlCenter
        .Columns("B").AutoFit
      
        .Columns("C").HorizontalAlignment = xlCenter
        .Columns("C").AutoFit
      
        .Columns("D").HorizontalAlignment = xlCenter
        .Columns("D").AutoFit
      
        .Columns("E").HorizontalAlignment = xlCenter
        .Columns("E").AutoFit
      
        .Columns("F").HorizontalAlignment = xlCenter
        .Columns("F").AutoFit
      
        .Columns("G").HorizontalAlignment = xlCenter
        .Columns("G").AutoFit
      
        .Columns("H").HorizontalAlignment = xlCenter
        .Columns("H").AutoFit
      
        .Columns("I").AutoFit
      
    End With

It's possible, if you want, to autofit multiple columns at once

ThisWorkbook.Worksheets("Sheet1").Range("A1:C1").EntireColumn.AutoFit

 

[The_Doc_Man]

Ah, well, "Dumb Doc" - but the "Entire Column" option was something I didn't find in the on-line documentation. And to be honest, after I got that working, I was a lot less worried about it.

 

[Isaac]

Ah, well, "Dumb Doc" - but the "Entire Column" option was something I didn't find in the on-line documentation. And to be honest, after I got that working, I was a lot less worried about it.

I hear you. To be totally honest, I'm actually not sure whether I've ever used the method I posted before. Can't remember. I just saw this post and, always take an interest in Excel VBA, so I did some futzing around for fun just to check. I may not have ever known about it before today!

 

[Gasman]

I thought I had adjusted a set of columns in the past.

I found this link which uses the EntireColumn individually

VBA Code To AutoFit Columns

In this macro code I list out four different scenarios in which you can use VBA to automatically determine what your column widths should be.

www.thespreadsheetguru.com

I will need to check another computer and report back, but likely used the method Isaac posted.

 

[Pat Hartman]

Here's a procedure I wrote to fix up a file after it was exported. It does a lot of different stuff that you might find useful.

Private Sub FormatWeeklyJobStatus(sFileName)

Const xlDown = -4121
Const xlCellTypeLastCell = 11
Const xlThemeFontMinor = 2
Const xlPrintNoComments = -4142
Const xlPortrait = 1
Const xlPaperLegal = 5
Const xlPaperLetter = 1
Const xlOverThenDown = 2
Const xlPrintErrorsDisplayed = 0
 
    Dim sPath           As String
    Dim sTemplateName   As String
    Dim lngRows           As Long       'MUST be long
Dim ref As Reference

' 0 if Late Binding
' 1 if Reference to Excel set.
#Const ExcelRef = 0
#If ExcelRef = 0 Then ' Late binding
    Dim appExcel As Object     'Excel Object
    Dim wbkNew As Object    'Workbook Object
    Dim wksNew As Object    'Sheet Object
    Dim wbkTemplate As Object   'Workbook Object for Template

    Set appExcel = CreateObject("Excel.Application")
    ' Remove the Excel reference if it is present   -   <=======
    On Error Resume Next
    Set ref = References!Excel
    If Err.Number = 0 Then
        References.Remove ref
    ElseIf Err.Number <> 9 Then 'Subscript out of range meaning not reference not found
        MsgBox Err.Description
        Exit Sub
    End If
' Use your own error handling label here
On Error GoTo FormatWeeklyJobStatus_Error
#Else
    ' a reference to MS Excel <version number> Object Library must be specified
    Dim appExcel As Excel.Application      'Excel Object
    Dim wbkNew As Excel.Workbook        'Workbook Object
    Dim wksNew As Excel.Worksheet       'Sheet Object
    Dim wbkTemplate As Excel.Workbook   'Workbook Object for Template

    Set appExcel = New Excel.Application
#End If

    On Error GoTo FormatWeeklyJobStatus_Error

    sPath = DLookup("Database", "MsysObjects", "[Name] = 'tblJob'")
    sPath = Left(sPath, InStrRev(sPath, "\"))
    sTemplateName = sPath & "WeeklyJobStatusHeaders.xlsx"

    Set wbkNew = appExcel.Workbooks.Open(sFileName)
    Set wksNew = appExcel.Worksheets("qWeeklyJobStatusReportExcel")
    
    'remove column names - some bug is preventing HasFieldNames argument from working on the export
    If wksNew.Range("A1").Value = "ContractName" Then
        appExcel.Rows("1:1").Select
        appExcel.Rows("1:1").Delete
    End If
    
    ' Insert 5 rows at top to make room for headers
    With appExcel

        .Rows("1:1").Select
        .Selection.Insert Shift:=xlDown
        .Selection.Insert Shift:=xlDown
        .Selection.Insert Shift:=xlDown
        .Selection.Insert Shift:=xlDown
        .Selection.Insert Shift:=xlDown
        
        ' Get headers from template file
        Set wbkTemplate = .Workbooks.Open(sTemplateName)
        wbkTemplate.Activate
        .Rows("1:5").Select
        .Selection.Copy
        
        ' Paste into new Workbook.
        wbkNew.Activate
        .ActiveSheet.Paste
        
        ' Close template
        .CutCopyMode = False    'clear clipboard to get rid of warning message
        wbkTemplate.Close
        
        'add job name
        .Range("A5").Value = Me.cboJob.Column(3)
        
        ' Count rows in new Workbook.
        .Selection.SpecialCells(xlCellTypeLastCell).Select
        lngRows = .Selection.Row
        
        'insert sum functions
            'the reference style below uses the current position so we subtract the number of rows (lngRows)
            'to get to the top and then add 5 to get past the headers
        .Cells(lngRows + 1, 4).Select     'column D - Total plan pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 5).Select     'column E - OFA pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 6).Select     'column F - BFA pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 7).Select     'column G - Issued to Shop pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 9).Select     'column I - Cut Issue pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 11).Select     'column K - Fitted pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 12).Select     'column L - Welded pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 13).Select     'column M - Shipped pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Range("A" & lngRows + 1 & ":N" & lngRows + 1).Select
        
        
        ' Freeze panes
        .Range("A6").Select
        .ActiveWindow.FreezePanes = True
        
        ' Header should print on every page when in Print Preview
        .ActiveSheet.PageSetup.PrintTitleRows = "$1:$5"
        .ActiveSheet.PageSetup.PrintTitleColumns = ""
        
       'format cells as numeric
        .Cells.NumberFormat = "#,##0_);[Red](#,##0)"
        
        ' Set format for date columns
        wksNew.Columns("H").NumberFormat = "d-mmm;@"
        wksNew.Columns("J").NumberFormat = "d-mmm;@"
            
        ' Set font and size
        .Cells.Select
        With .Selection.Font
            .Name = "Calibri"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .TintAndShade = 0
            .ThemeFont = xlThemeFontMinor
        End With
        
        ' Set page setup properties
        .Columns("A:N").Select
        .Selection.Columns.AutoFit
        
        With .ActiveSheet.PageSetup
            .PrintArea = "$A$1:$N$" & CStr(lngRows + 2)
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = appExcel.InchesToPoints(0.5)
            .RightMargin = appExcel.InchesToPoints(0.5)
            .TopMargin = appExcel.InchesToPoints(0.5)
            .BottomMargin = appExcel.InchesToPoints(0.5)
            .HeaderMargin = appExcel.InchesToPoints(0.5)
            .FooterMargin = appExcel.InchesToPoints(0.5)
            .PrintHeadings = False
            .PrintGridlines = True
            .PrintComments = xlPrintNoComments
           ' .PrintQuality = 600
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlPortrait
            .Draft = False
            .PaperSize = IIf(lngRows > 44, xlPaperLegal, xlPaperLetter)
            .FirstPageNumber = xlAutomatic
            .Order = xlOverThenDown                         ' Change order to print all "page 1" before "page 2"
            .BlackAndWhite = False
            ''.Zoom = 80                                      ' Shrink down a little
            .Zoom = False                                   ' Should not need both
            .FitToPagesWide = 1
            .FitToPagesTall = False
            .PrintErrors = xlPrintErrorsDisplayed
        End With
    End With

    wbkNew.Save

FormatWeeklyJobStatus_Exit:
    On Error Resume Next
    ' Required for cleanup.
    wbkNew.Close
    Exit Sub

FormatWeeklyJobStatus_Error:
    Select Case Err.Number
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FormatWeeklyJobStatus of VBA Document Form_frmReports"
    End Select

    Resume FormatWeeklyJobStatus_Exit

End Sub

 

[The_Doc_Man]

@Pat Hartman - Looking at the routine you just posted in #11, I have a question. You have this construct:

   Select Case Err.Number
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FormatWeeklyJobStatus of VBA Document Form_frmReports"
    End Select

It is clear that you could have done that as a convenient place for dropping a break-point, and I could imagine that you do this if sometimes there is an error you wanted to catch and handle differently, sometimes not. But is there another hidden agenda for using a SELECT CASE in that context, or was it just a "scaffold" for the cases where you wanted to trap specific errors?

 

[A1ex037]

Thank you guys for your suggestions. As Isaac suggested, I started from exporting only, looked through several similar threads and I have something that is roughly working on the first segment of my question (exporting to Excel, and formatting first 4 columns as needed). I'm having little trouble at the end (not sure how to autosave file in excel). Not sure if I have to declare workbook and sheet as object, some examples are doing it with, some without. I am still learning a lot of this stuff, so it gets pretty confusing sometimes.

Private Sub btnExport2Excel_Click()

Dim sFilename As String
Dim filePath As String

    sFilename = "qryProba"
    filePath = Application.CurrentProject.Path & "\" & sFilename & ".xlsx"

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, sFilename, filePath, True

Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")

xlApp.Workbooks.Open filePath, True, False
xlApp.Columns("a:c").EntireColumn.AutoFit

With xlApp
.Columns("D:D").NumberFormat = "General"
.Rows(1).EntireRow.Delete
End With

xlApp.Visible = True
xlApp.Application.Quit

End Sub

One more thing is needed (before moving to "heavy" stuff), and that is to remove line breaks generated from access. So far, this was done directly in Excel (bring up search & replace dialog, search: CTRL+J; replace: SPACE).

Thank you all for your effort.

 

[Isaac]

Try this:

Private Sub btnExport2Excel_Click()

Dim sFilename As String
Dim filePath As String

sFilename = "qryProba"
filePath = Application.CurrentProject.Path & "\" & sFilename & ".xlsx"

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, sFilename, filePath, True

Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")

'ADDED:
Dim wb As Object, ws As Object 'workbook & worksheet

'ADDED:
Set wb = xlApp.Workbooks.Open(filePath, True, False)
Set ws = wb.Sheets(1)
'REMOVED:
'xlApp.Workbooks.Open filePath, True, False

'ADDED:
ws.Range("a1:c1").EntireColumn.AutoFit

'REMOVED. removed because of xlApp.Columns, but also prefixed Entirecolumn with Range object, as it's the way I know will work-not sure about the other way
'xlApp.Columns("a:c").EntireColumn.AutoFit

'With xlApp 'replaced
With ws
.Columns("D:D").NumberFormat = "General"
.Rows(1).Delete
End With

'REMOVED:
'xlApp.Visible = True

'ADDED:
wb.Close True ' "true" saves the workbook

xlApp.DisplayAlerts = False 'I added this just to ensure 100% that no UI prompts come up
xlApp.Application.Quit

End Sub

Note: Is the code that does the columns Autofit, NumberFormat, are they working? I am not sure - because my original suggestion was more along the lines of RangeObject.EntireColumn.Autofit whereas you are doing it a little bit differently. But may be fine. Either way I edited one place to use RangeObject.Entirecolumn rather than just columns.entirecolumn.

One more thing is needed (before moving to "heavy" stuff), and that is to remove line breaks generated from access. So far, this was done directly in Excel (bring up search & replace dialog, search: CTRL+J; replace: SPACE).

Are you sure the manual way was working? If you really have line break type of characters present (i.e. Chr(10) or Chr(13)), then Finding and replacing a Space won't cut it. Or is it? Or is that even what you meant? I may have misunderstood.
Either way, for coding a Find and Replace, this is a moment when using the macro recorder to get a head start is definitely a legit approach. After you use the macro recorder to get the general idea, examine the code it produces, and get rid of things like Select and Selection, and replace them with references to specific ranges or columns (etc). And reference your specific worksheet. I can help if needed.

 

[A1ex037]

Isaac, thanks for suggestion. It works exactly as I wanted it to. Now, with wb declared, seems that there is more control over the entire process. I also don't have "save as" dialog when exiting Excel.

Regarding the question about manual way, it was working perfectly (we have done it a million times). I found CTRL+J usage here. When recording macro, this is what I got:

Cells.Replace What:="" & Chr(10) & "", Replacement:=" ", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

I also found some code about it here. I will try it this afternoon.

 

[Isaac]

Isaac, thanks for suggestion. It works exactly as I wanted it to. Now, with wb declared, seems that there is more control over the entire process. I also don't have "save as" dialog when exiting Excel.

Great! Glad to hear things are working out.

As for Ctrl+J, now I see what you mean - Ctrl+J is for once the find and replace dialogue is open. Neat trick I never knew about. The Find and Replace code is about what I would have suggested and ought to work. I usually test and make sure whether chr(10) or chr(13) is there, this may be overdo on my part but I always tend to suspect them both. Depends on the source of line breaks I guess. Glad to hear you got things working.

 

[A1ex037]

Well, I have managed to get it with the search and replace (good call Isaac for idea about macro recording). Took me an hour to figure out that I have to include excel object library, but at the end there is some satisfaction when everything is working OK.
Now to the most important part. I will try to explain in detail what is needed.

Every day, one section of the items table is exported and sent to the warehouse. All items in a table have the appropriate letters in one column (A, A1, B, B1... M, M1). Exported list includes items (for example, B) that are "active" (means they can be worked with), and items that have arrived, but are not inspected yet ("inactive"). Exported excel file should have "inactive" items highlighted (so that the person who takes care of the file at the end of the process could identify them easily). At the same time, once the file is exported to Excel, all "inactive" status (checkbox) should be updated to "active".

If I understand correctly, there should be letters from that column displayed on a form (listbox, dropdown or buttons), last used letter should be marked (or read from existing query), next letter is selected and once the button for export2Excel is clicked, letter gets updated in existing query, file gets exported to Excel (with the code above). Somewhere in between, I have to figure out how to highlight "inactive" in excel file and then update checkbox value to "active".

 

[Isaac]

Well for the needed Access updates, can't you basically take whatever existing process you have that apparently, successfully takes all of this form and user interface related actions and performs the correct export query...then create an update query and only select items (from the export query) whose status is Inactive and update to Active?

For the coloring in Excel. The typical short answer might be to use VBA to apply some conditional formatting. Theoretically this type of code is probably the fastest-running option. For some reason (and this is just me), I don't use conditional formatting very often and would probably just write a loop to check the value of cells and apply a RangeObject.Interior.Color=vbYellow or something like that. I guess I always feel like I have more flexibility and control doing that rather than concocting conditional formatting 'rules'. It may just be me on that. Could be I am just too lazy to figure out the VBA for applying detailed conditional formatting rules (which is probably just a few seconds with the macro recorder again).

Then again, one thing I've learned from the macro recorder vs. super "generic" code I might write from scratch is this: Methods and properties which are NEWLY added to new Excel versions tend to crop up when recording macros. I.E., the recorder prefers the most modern code, and tends to always use it, no matter how obscure the basis or how uncommon it may be across wide version base. Which is great, until you rely on it assuming that it's something generic and then deploy to a user with a slightly different Excel version. Recently I had this experience when recording a macro to refresh my memory on a Sort syntax. The recorder used the SortFields.Add2 method, which is a very modern change to the traditional SortFields.Add method. Add2 method adds some obscure little capability that I'd never want or care about - and DIDN'T work on my end user's Excel 2010. I would hazard a guess that Conditional Formatting code is something the macro recorder will use the newest and best methods that may not exist in other versions, just something to watch for.

 

[A1ex037]

For the coloring, I thought about exporting the checkbox column. That would appear as True/False in Excel, then highlight all false and at the end delete checkbox column? After that, I could use an update to change it in tblItems.

 

[Isaac]

For the coloring, I thought about exporting the checkbox column. That would appear as True/False in Excel, then highlight all false and at the end delete checkbox column? After that, I could use an update to change it in tblItems.

Oh yeah - your Active/Inactive is a yes/no column in Access, I forgot that. Yep - makes sense to me.
One thing I avoid at all costs is getting users too used to "working" anything (esp. in Excel) based on colors. The reason is that I find inevitably down the road, it seems like it comes back to bite me. I.E., they'll give me some worksheet they've been working on and I have to "do" something database-related with it, and I'm then at the mercy of color indicators, which of course is no use whatsoever other than for a person eyeballing a rather small set of records. I would rather give them the necessary columns and just encourage them to filter as necessary.
But of course, if coloring is part of the requirements and suits the need, it's all good. That just came to mind when I thought of all the times users have proudly presented to me their "finished spreadsheet" of what was supposed to be useable data to me, and I find out that half of the entire interpretation depends on my two arch nemesis in processing end-user-manipulated data: hidden rows/columns and colors. : )