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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

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

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

840 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