Export to Excel, Change Cell Colour

nick1408

Board Regular
Joined
Jan 18, 2010
Messages
82
Hi again guys and girls,

I am having my first real crack of VBA within Access to export and format Excel. My current code is as follows:

Code:
Sub ExportToExcel()
  On Error GoTo errorhandler
    Dim xlApp As Object
    Dim xlSheet As Object
    Dim oBook As Object
    Dim stamp As String
stamp = Month(Date) & Day(Date) & Year(Date)
  
         'check & close any instance of Excel running
        Set xlApp = CreateObject("Excel.Application")
        If Not (xlApp Is Nothing) Then
            xlApp.Application.DisplayAlerts = False
            xlApp.Workbooks.Close
            xlApp.Quit
            Set xlApp = Nothing
        End If
        
        Set xlApp = CreateObject("Excel.Application")
        
        xlApp.Visible = True
 Dim outputFileName As String
outputFileName = CurrentProject.Path & "\Export_" & Format(Date, "yyyyMMdd") & ".xls"
DoCmd.OutputTo acOutputReport, ActiveReport, acFormatXLS, outputFileName, True
 xlApp.Workbooks.Open outputFileName, True, False
     Set xlApp = CreateObject("Excel.Application")
 xlApp.Visible = True
 Set XlBook = GetObject(outputFileName)
 XlBook.Windows(1).Visible = True
'xl.ActiveWindow.Zoom = 75
 'Define the sheet in the Workbook as XlSheet
Set xlsheet1 = XlBook.Worksheets(1)
Set oBook = xlApp.Workbooks.Open(outputFileName)
 
'Then have some fun!
With xlsheet1
'    .range("A1") = "some data here"
'    .columns("A:A").HorizontalAlignment = xlRight
 '   .rows("1:1").Font.Bold = True
 
' Dim lRow As Long
 'lRow = Cells(Rows.Count, 1).End(xlUp).Row
 
  .Columns("A:A").EntireColumn.AutoFit
  .Columns("b:b").EntireColumn.AutoFit
  .Columns("c:c").EntireColumn.AutoFit
  .Columns("d:d").EntireColumn.ColumnWidth = 5
  .Columns("f:f").EntireColumn.AutoFit
  .Columns("g:g").EntireColumn.AutoFit
  .Columns("h:h").EntireColumn.AutoFit
  .Columns("i:i").EntireColumn.AutoFit
  .Columns("j:j").EntireColumn.AutoFit
  .Columns("k:k").EntireColumn.AutoFit
  .Columns("l:l").EntireColumn.AutoFit
.Columns("m:m").EntireColumn.AutoFit
  .Columns("n:n").EntireColumn.AutoFit
.Columns("o:o").EntireColumn.AutoFit
 .Columns("p:p").EntireColumn.AutoFit
 .Columns("q:q").EntireColumn.AutoFit
 .Columns("r:r").EntireColumn.AutoFit
 .Range("R2").clearcontents
       .Range("B1").clearcontents
     .Columns("E:E").WrapText = True
 End With
 'Filter only rows where cell value = 1 to speed up color formatting by only
                        'editing the filtered rows rather than all the rows in the range
                        '20160218
                        .autofiltermode = False
                        .Range(.Cells(1, 1), .Cells(lastrow, 1)).AutoFilter Field:=1, Criteria1:="1"
                        For Each cell In .Range(.Cells(2, 1), .Cells(lastrow, 1)).SpecialCells(xlCellTypeVisible)
                        'For Each cell In .Range(.Cells(2, 1), .Cells(lastrow, 1))
                            Select Case cell.Value
                                Case Is = 1: indexcolor = 3 'vbred
                                Case Is = 0: indexcolor = 1 'vbblack
                                Case Else: indexcolor = xlNone
                            End Select
     
     .rows(2).HorizontalAlignment = xlCenter
        
.Range("A2:A65000").rows.AutoFit
        
'  ActiveWorkbook.Close SaveChanges:=True
        
 
   oBook.Close True 'True = save changes
 Exit_Proc:
    Set xlApp = Nothing
    Set xlSheet = Nothing
    Exit Sub
 errorhandler:
    MsgBox ("There is an error in the report." & vbNewLine & "Check Date Milestone Met column." & vbNewLine & "Ensure one of steps, 1, 4, 11, 12, 13 15, 21, 22, 24, 28, 35,36 or 38 are selected." & vbNewLine & "Ensure MS Excel is not already open when trying to export" & vbNewLine & "If error still persists after these checks contact administrator")
End Sub

What I would like to do is add a bit at the bottom to change cell background colours depending on cell contents. I want a cell containing 'At Risk' to have bold text and a red background, 'Caution' to have an orange background with italic text and 'On Track' to have a green background.

I also have some (what I think are) easier questions. Two bits of my code aren't working as expected:

Code:
  'check & close any instance of Excel running
        Set xlApp = CreateObject("Excel.Application")
        If Not (xlApp Is Nothing) Then
            xlApp.Application.DisplayAlerts = False
            xlApp.Workbooks.Close
            xlApp.Quit
            Set xlApp = Nothing
        End If

I expected this to close any open instances of Excel but it doesn't. Why is this?

This bit:

Code:
 Set oBook = xlApp.Workbooks.Open(outputFileName)
 ...
    oBook.Close True 'True = save changes

I expect to close and save what I just created but it doesn't. What have I done wrong? What would be even better than this is if I could change the papersize to Tabloid, landscape and shrint to fit columns on one page then save as a .pdf. That would be the ultimate goal here but to save would be ideal.

One last thing -
Code:
'     .cells("2:2").select.HorizontalAlignment = xlCenter

I wanted to centre on row 2 but it didn't work. Now commented out. What is the right way to centre text?

So far I have tried the following alternitives:
Code:
'Filter only rows where cell value = 1 to speed up color formatting by only
                        'editing the filtered rows rather than all the rows in the range
                        '20160218
                        .autofiltermode = False
                        .Range(.Cells(1, 1), .Cells(lastrow, 1)).AutoFilter Field:=1, Criteria1:="1"
                        For Each cell In .Range(.Cells(2, 1), .Cells(lastrow, 1)).SpecialCells(xlCellTypeVisible)
                        'For Each cell In .Range(.Cells(2, 1), .Cells(lastrow, 1))
                            Select Case cell.Value
                                Case Is = 1: indexcolor = 3 'vbred
                                Case Is = 0: indexcolor = 1 'vbblack
                                Case Else: indexcolor = xlNone
                            End Select
Code:
'Conditional Formatting
                    For Each cell In .Range(.Cells(3, 3), .Cells(lastrow, 3))
                        Select Case cell.Value
                            Case Is = 5: indexcolor = 6 'stRGB = "rgb(255,255,0)"    Couldn't figure out how to put the rgb in variable
                            Case Is = 10: indexcolor = 45 'stRGB = "rgb(255,192,0)"  so used the closest ColorIndex based on the above
                            Case Is = 15: indexcolor = 43 'stRGB = "rgb(146,208,80)" mentioned website
                            Case Is = 20: indexcolor = 38 'stRGB = "rgb(255,204,255)"
                            Case Is = "ALL": indexcolor = 28 'stRGB = "rgb(0,255,255)"
                        End Select
                        .Range(.Cells(cell.row, 1), .Cells(cell.row, lastCol + 1)).Interior.ColorIndex = indexcolor
                    Next cell

I'm not sure where to put the colour filtering code. If I put it before the End With I get a compile error: End With without With and if I put it after the End With I get a compile error: Invalid or unqualified reference on the .autofiltermode.

I have tried alternatives for xlcenter as well:
Code:
.rows(2).HorizontalAlignment = xlCenter

this throws a runtime error '1004' Unable to set the HorozontalAlignment property of the Range class

I'm using Office 2013

Thanks for the help on a weekend.
 
The issue is not whether or not this is the appropriate forum. The issue is cross posting without declaring it. The link was an attempt to inform anyone who chooses to read the topic regarding the proper etiquette.

Appreciate you posted the link for the cross post - I didn't read the rules on that.

PMFJI, but that is what I have done and it is so much easier that creating conditional formatting on the fly. That of course is as long as the formatting is remaining the same.
I was initially creating the conditional formatting rules in VBA as I started the project in Excel, but now I have moved it to Access I use a template with all the settings and just fill it with data.

FWIW I have only recently see a post about formatting alignment for xlTop which did not work and had to use a constant instead.
Formatting for Excel workbook exported from Access - Access World Forums

so your problem with horizontal alignment might be similar?

It looks like it may be. I have added the MS Excel 15 reference. Now I'm trying to work out how to add the constant (or at least, the correct syntax for it)
 
Upvote 0

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Set xlApp = CreateObject("Excel.Application")
If Not (xlApp Is Nothing) Then
xlApp.Application.DisplayAlerts = False
xlApp.Workbooks.Close
xlApp.Quit
Set xlApp = Nothing
End If

Set xlApp = CreateObject("Excel.Application")

The problem is you:
1) create an xlApp
2) check if an xlApp is open
3) close an xlApp
4) create an xlApp

Wrong.

Instead simply:
1) create an xlApp
2) do stuff
3) close it

you can use your error handler to make sure it's closed properly, so then no need to worry about instances hanging around.

As far as cross-posting you have now read the rules, and you know what to do (which is provide a link if you have asked the same question in another place). So we can close the book on that one now.

Note that using a reference to Excel may help you in developing your code but I would remove it once it's tested and working - the reference will cause problems at some point if/when users upgrade to another version of Excel and that's unpleasant (unless you are the only user, since you will know how to fix it).
 
Last edited:
Upvote 0
The problem is you:
1) create an xlApp
2) check if an xlApp is open
3) close an xlApp
4) create an xlApp

Wrong.

Instead simply:
1) create an xlApp
2) do stuff
3) close it

you can use your error handler to make sure it's closed properly, so then no need to worry about instances hanging around.

[\QUOTE]

Thanks for pointing that out like that. It does help to see the error I created.

As far as cross-posting you have now read the rules, and you know what to do (which is provide a link if you have asked the same question in another place). So we can close the book on that one now.

Note that using a reference to Excel may help you in developing your code but I would remove it once it's tested and working - the reference will cause problems at some point if/when users upgrade to another version of Excel and that's unpleasant (unless you are the only user, since you will know how to fix it).

I had the exact same thought re: using a reference. What is the best way to get my cells centered? Even if I have to .range("A2").horizontalAlignment = xlCenter each cell I would be happy enough but I just can't get it to work.
 
Last edited:
Upvote 0
Without a reference, you can't use xlCenter. That's a named constant that needs an active reference to be resolved. Without a reference you have to use the numeric value of the constant.

.range("A2").horizontalAlignment = -4108

Personally I do use preformatted workbooks when feasible (a "template") so I don't have to write a lot of formatting code.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,219
Members
452,620
Latest member
dsubash

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