Export to Excel - Format the Spreadsheet at the same time

[jcw5107]

Below is code that I am working with that exports a MS Access query to a MS Excel spreadsheet.
Right now the way this code works is it fills the column headings (field names from query) with a color, and it fills in the range of data to Excel with a different color.
Which is awesome..!! I just need the rows to be colored a different way based on a field in the exported query.
So if rst!PlanStatus = "D" then those rows get a certain color, and if rst!PlanStatus = "A" the font in those rows get a certain color...
Any examples or suggestions as to how I can manipulate this code to "highlight" only the rows (in Excel) that have a certain value in the exported query field PlanStatus..??
Thanks in advance.!!
jcw5107

Public Sub P_SendDataToExcel()
On Error GoTo ErrTrap
Dim QryName As String, Cnt As Long
Dim Qst As String
Dim Rw1 As Long, CL1 As Long
Dim FieldCount As Long, TotRec As Long
Dim strMessage As String

Dim exp As Excel.Application
Dim ws As Excel.Worksheet
Dim rg As Excel.Range
Dim db As DAO.Database
Dim rst As DAO.Recordset

strMessage = "Data Will Get Exported To Excel Workbook " & _
DestnFileName & vbCrLf & "(Active Sheet Will " & _
"Get Renamed As Per Exported Query)" & _
vbCrLf & "Full Path - " & DestnFilePath & _
vbCrLf & vbCrLf & "Shall We Continue?"
If Not Confirm(strMessage) Then
GoTo ExitPoint
End If
QryName = Me.SF_Sub.Form.RecordSource
If Len(QryName) > 0 Then
Else
DisplayMessage "No Data To Export"
GoTo ExitPoint
End If

Set db = DBEngine(0)(0)
' Set exp object to already open Excel application
' (Destn Excel File Opened In Web Browser Control
Set exp = GetObject(, "Excel.Application")
Set ws = exp.ActiveSheet
Rw1 = exp.ActiveCell.Row
CL1 = exp.ActiveCell.Column
' Create a recordset based upon current query
Set rst = db.OpenRecordset(QryName)
FieldCount = rst.Fields.Count
rst.MoveLast
TotRec = rst.RecordCount
rst.MoveFirst
' Clear Any existing contents, highlights or borders
Set rg = ws.Range(ws.Cells(Rw1, CL1), _
ws.Cells(Rw1 + TotRec, CL1 + FieldCount - 1))
rg.Clear
' Populate column headings in excel worksheet
For Cnt = 0 To FieldCount - 1
ws.Cells(Rw1, Cnt + CL1) = rst.Fields(Cnt).Name
Next
' Export recordset data to Excel worksheet
Set rg = ws.Range(ws.Cells(Rw1 + 1, CL1), ws.Cells(Rw1 + 1, CL1))
rg.CopyFromRecordset rst

' Highlight the Column Headings
Set rg = ws.Range(ws.Cells(Rw1, CL1), _
ws.Cells(Rw1, CL1 + FieldCount - 1))
'rg.Interior.ColorIndex = 8

' Highlight the Data Block
rst.MoveLast
Cnt = rst.RecordCount
Set rg = ws.Range(ws.Cells(Rw1 + 1, CL1), _
ws.Cells(Rw1 + TotRec, CL1 + FieldCount - 1))
rg.Interior.ColorIndex = 19
' Provide Border around exported material
Set rg = ws.Range(ws.Cells(Rw1, CL1), _
ws.Cells(Rw1 + TotRec, CL1 + FieldCount - 1))
' rg.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
P_MakeBorders rg
' Name the active sheet as per exported query
' Go to first cell of exported block & save the workbook
ws.Name = DLookup("Fleet", "FleetMstr", "[FleetID] =getglobal('GBLFleetID')") & "WE" & Format(Date + (6 - Weekday(Date)) + 1, "mmddyy")
ws.Cells(Rw1, CL1).Select
exp.ActiveWorkbook.Save

ExitPoint:
On Error Resume Next
Set rg = Nothing
Set ws = Nothing
Set exp = Nothing

rst.Close
Set rst = Nothing
Set db = Nothing
On Error GoTo 0
Exit Sub

ErrTrap:
DisplayMessage Err.Number & " - " & Err.DESCRIPTION
Resume ExitPoint
End Sub

 

[JerryKlmns]

Conditional formatting ...

 

[jcw5107]

Ahhh.. Man...
The code I posted uses an ActiveX control....
Theres gotta be a way to format each row based on a field value in the exported query...!!
I'm so close..!!
Thanks for suggestion, but I don't how to use Conditional Formating over the range of field/records that is exported...
Thanks..!
jcw5107

 

[jcw5107]

All:

The part of the code thats...

' Highlight the Data Block
rst.MoveLast
Cnt = rst.RecordCount
Set rg = ws.Range(ws.Cells(Rw1 + 1, CL1), _
ws.Cells(Rw1 + TotRec, CL1 + FieldCount - 1))
rg.Interior.ColorIndex = 19

...is where I think something like...

if rst!PlanStatus = "D" then
set rg .... FontBold and Background lite gray...?????
end if
if rst!PlanStatus = "A" then
set rg......FontColor red and FontBold
End if

...should go...?? I'm not sure and don't have the skills to manipulate the code as so..

OR should there be a VB macro in Excel that runs to do what I'm requesting. The exported query is sent to a template.xls and then saved as another .xls -

Any suggestions or examples...?
Thanks for all the help..!!
jcw5107

 

[SkipVought]

    Set rg = ws.Range(ws.Cells(Rw1 + 1, CL1), ws.Cells(Rw1 + 1, CL1))
    rg.CopyFromRecordset rst

' Highlight the Data Block
'    rst.MoveLast
'    Cnt = rst.RecordCount
    Set rg = rg.CurrentRegion
    
    rg.Interior.ColorIndex = 19

'...is where I think something like...

    iColPlanStatus = rg.Find("PlanStatus").Column
    
    
    rg.Select
    If rst!PlanStatus = "D" Then
        'set rg .... FontBold and Background lite gray...?????
        Selection.FormatConditions.Delete
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & Cells(rg.Row, iColPlanStatus).Address(True, False) & "=""A"""
        With Selection.FormatConditions(1).Font
            .Bold = True
            .Italic = False
        End With
        Selection.FormatConditions(1).Interior.ColorIndex = 15
    End If

Skip,

_[red][/red]

 

[jcw5107]

Skip,

I keep gettin' an "Variable not defined" error message. On debug it highlights iColPlanStatus....
Any fixes...??
I'm messin' with it and tryin' a fix on my own,,, but I ain't havin' no luck..!!

Thanks for the help..!!
jcw5107

 

[PHV]

Simply add the following :
Dim iColPlanStatus As Integer

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886