Formatting Created Spreadsheet

Posted on 2011-02-28
Last Modified: 2012-05-11
I want to do some formatting to a spreedsheet created from my app.  Specifically I want to color code each row based on the value of one of the cells in that line.

I have used Access to create spreadsheets from spreadsheets for my client on several occasions.  With the help of EE I have also developed logic to do some formatting to the created spreadsheet.  In the first examle(fixSpreadsheet)  shown in the code window I revised the format of a group of cells to 'numeric'.  In the second example (ExcelCreateColumnCheckboxes)  I create a 'checkbox' in the last column of the spreadsheet.

Both of these code snippets work and have been in production for quite a while.

The generated spreasheet has 6 tabs on it with varying number of rows per tab.  The color coding should apply to all six tabs.

In each row the value that I want to base the color coding on is in row 'P'.  If the value is 2 I want the entire row of cells to be yellow.  If the value is 3 or more I want the entire row of cells to be red.

Anyone know how to accomplish this from Access using VB code similar to what is used in the two example in the code snippet window.  Or any other way using VBA for that matter?

The pseudo code would be.  

open the spreadhseet

For each tab on the spreadsheet
     For each row on the tab
         If the contents of cell 'P = 2
             make all of the cells in the row yellow
        elseif the contents of cell 'P' is greater than 2
             make all the cells in the row red

save the spreadsheet
close the spreadsheet
Private Sub fixSpreadsheet(passedNameAndLoc As String)
Dim xlApp As Object, xlWb As Object, xlWs As Object
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open(passedNameAndLoc)

Public Function ExcelCreateColumnCheckboxes( _
    sFileName As String, _
    sColumnHeading As String, _
    Optional vWorkSheet As Variant = 1 _
  ) As Boolean
Dim oXL As Excel.Application
Dim oWkb As Excel.Workbook
Dim oSht As Excel.WorkSheet
Dim oChk As Excel.CheckBox
Dim rCell As Excel.Range
Dim sCellName As String
Dim iRow As Integer
Dim iCol As Integer
Dim fHadError As Boolean

'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
'                             Copyright 2010 Twin Hills Software LLC
                               On Error GoTo ExcelCreateColumnCheckboxes_Error
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------

On Error GoTo ProcErr
  Set oXL = CreateObject("Excel.Application")
  Set oWkb = oXL.Workbooks.Open(sFileName)
  Set oSht = oWkb.Worksheets(vWorkSheet)
  With oSht
    ' find the column to work with
    For iCol = 1 To .UsedRange.Columns.Count
      If .Cells(1, iCol) = sColumnHeading Then Exit For
    If iCol > .UsedRange.Columns.Count Then
      Err.Raise 5, , "Column header '" & sColumnHeading & "' not found"
    End If
    For iRow = 2 To .UsedRange.Rows.Count
      sCellName = .Cells(iRow, iCol).Address
      Set rCell = .Range(sCellName)
      With rCell
        ' don't display the value in the cell
        .NumberFormat = ";;;"
        ' create a checkbox, centered in cell, using minimum height/width
        Set oChk = oSht.Checkboxes.Add(.Left + .Width / 2 - 7, .Top - 1, 0, 0)
      End With
      With oChk
        .Name = sCellName
        ' remove the pesky default label
        .Characters.Text = ""
        ' set the initial value
        .Value = CBool(rCell)
        ' link to the cell
        .LinkedCell = sCellName
      End With
  End With
  oWkb.Close SaveChanges:=True
  On Error Resume Next
  If Not oXL Is Nothing Then
    If fHadError Then oXL.DisplayAlerts = False
    Set oXL = Nothing
  End If
  ExcelCreateColumnCheckboxes = Not fHadError
  Exit Function
  MsgBox Err.Description, vbExclamation, "Error in ExcelCreateColumnCheckboxes"
  fHadError = True
  Resume ProcEnd

'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
                               On Error GoTo 0
                               Exit Function
                               sysErrorHandler Err.Number, Err.Description, "ExcelCreateColumnCheckboxes", "modMortgageExport_Import", "Module"
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------

End Function
Set xlWs = xlWb.Worksheets(1)
'xlWs.Range("G:J").NumberFormat = "0" 'columns 7-10
xlWs.Range("F:P").NumberFormat = "0"
'repeat as needed
With xlWb
End With
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
End Sub

Open in new window

Question by:mlcktmguy
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 35001111
Then please click the "Request Attention"  link and ask that this Q be linked to the Excel Zone.

Author Comment

ID: 35001392
Thanks, never even realized that 'Request Attention' was there.
LVL 22

Accepted Solution

rspahitz earned 250 total points
ID: 35009252
" I want to color code each row based on the value of one of the cells in that line."
In Excel this is normally done through Conditional Formatting.  If this has to be done through code, I guess the easy way is to record a macro, perform the task, stop the recording and see what comes out and move it to your code area.

So following up on that, using this "In each row the value that I want to base the color coding on is in row 'P'.  If the value is 2 I want the entire row of cells to be yellow.  If the value is 3 or more I want the entire row of cells to be red." I get the following:

Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=""P1=2"""
    With Selection.FormatConditions(1).Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = &HFFFF  ' vbYellow
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=""p1=3"""
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = &HFF ' vbRed
    End With
    Selection.FormatConditions(1).StopIfTrue = False

Open in new window

You may need to adjust this since I set it to apply only to Row 1 (where P1="2")
Let me know if you need help with that.

Featured Post

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

930 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now