Formatting Created Spreadsheet

Posted on 2011-02-28
Medium Priority
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
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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 1000 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: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying 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

Did you know that more than 4 billion data records have been recorded as lost or stolen since 2013? It was a staggering number brought to our attention during last week’s ManageEngine webinar, where attendees received a comprehensive look at the ma…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

771 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