Exporting Query to Excel Conditional Formatting

[RobotronX]

I have been trying to make some conditional formatting happen in VBA for the past couple of days and can't seem to figure it out.


I've got a query that I am exporting to Excel, right now this is done by Cut and Past and its taking a couple of hours a day and there are too many mistakes.

I am new to VBA but I have been reading and watcing alot of videos and figured out almost everything I am trying to do.

Hope I can describe this right:

In each row of data column M has a text value "Red", "Green", " Orange"
I need to make the same ROW and COL (D to L) match the color in Col M

My code loops so I was thinking I add it into the loop when I populate each row. But cant get it to work
I also tried to just add the formating afte the sheet is built but can't get that to work either.

Really I am at a loss, I have tried so may ways and now I am just making myself crazy.







Sub BudYTDAct()


On Error GoTo SubError

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim SQL As String
Dim rs1 As DAO.Recordset
Dim i As Integer

Dim intCounterAVP As Integer
Dim strAVP As Variant

strAVP = Array("Wat", "And", "Far", "NI", "M", "R", "C", "B", "Cer", "Noll")

DoCmd.SetWarnings False
DoCmd.Hourglass (True)

Set xlApp = Excel.Application
xlApp.Application.DisplayAlerts = False
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add



For intCounterAVP = 0 To 9

'MsgBox strAVP(intCounterAVP)


intSheets = xlBook.Worksheets.Count
Set xlSheetLast = xlBook.Worksheets(intSheets)
Set xlSheet = xlBook.Worksheets.Add(, xlSheetLast, 1, xlWorksheet)



With xlSheet
.Name = strAVP(intCounterAVP)

.Cells.Font.Name = "Arial"
.Cells.Font.Size = 10

ActiveWindow.DisplayGridlines = False

'Set column widths
.Columns("A").ColumnWidth = 1
.Columns("B").ColumnWidth = 12
.Columns("C").ColumnWidth = 12
.Columns("D").ColumnWidth = 17
.Columns("E").ColumnWidth = 50
.Columns("F").ColumnWidth = 17
.Columns("G").ColumnWidth = 17
.Columns("H").ColumnWidth = 17
.Columns("I").ColumnWidth = 17
.Columns("J").ColumnWidth = 17
.Columns("K").ColumnWidth = 17
.Columns("L").ColumnWidth = 50
.Columns("M").ColumnWidth = 8

.Range("A3").Activate
ActiveWindow.FreezePanes = True

'Format columns
.Columns("A").NumberFormat = "@"
.Columns("G").NumberFormat = "$#,##0_);($#,##0);-"
.Columns("H").NumberFormat = "$#,##0_);($#,##0);-"
.Columns("I").NumberFormat = "$#,##0_);($#,##0);-"
.Columns("J").NumberFormat = "$#,##0_);($#,##0);-"
.Columns("K").NumberFormat = "###0.0%;-###0.0%;-"

'build column headings
.Range("A2").Value = ""
.Range("B2").Value = "VP"
.Range("C2").Value = "AVP"
.Range("D2").Value = "Master Project ID"
.Range("E2").Value = "Master Project Name"
.Range("F2").Value = "Budget Entity"
.Range("G2").Value = "Actuals"
.Range("H2").Value = "Budget"
.Range("I2").Value = "High Range"
.Range("J2").Value = "Low Range"
.Range("K2").Value = "% Spent"
.Range("L2").Value = "Explanation"
.Range("M2").Value = "Status"


'Format Column Headings
.Range("B2:L2").HorizontalAlignment = xlCenter
.Range("B2:L2").Cells.Font.Bold = True
.Range("B2:L2").Interior.Color = RGB(0, 0, 0)
.Range("B2:L2").Font.Color = RGB(255, 255, 255)


'***************************************


'SQL statement
SQL = "SELECT VP, AVP, [Master Project ID], [Master Project Nm], [Budget Entity], Actuals, Budget, [% Spent], Explanation, Status, [High Range], [Low Range], ABSSORT, " & _
"(Actuals - Actuals) / Actuals AS Discount " & _
"FROM BudgetvsYTDActuals " & _
"Where AVP = """ & strAVP(intCounterAVP) & """" & _
"ORDER BY VP, AVP, [Status] DESC, ABSSORT DESC,[Master Project ID] "

'Execute query and populate recordset
Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)


'provide initial value to row counter
i = 3
'Loop through recordset and copy data from recordset to sheet
Do While Not rs1.EOF

.Range("B" & i).Value = Nz(rs1!VP, "")
.Range("C" & i).Value = Nz(rs1!AVP, "")
.Range("D" & i).Value = Nz(rs1![Master Project ID], "")
.Range("E" & i).Value = Nz(rs1![Master Project Nm], "")
.Range("F" & i).Value = Nz(rs1![Budget Entity], "")
.Range("G" & i).Value = Nz(rs1!Actuals, 0)
.Range("H" & i).Value = Nz(rs1!Budget, 0)
.Range("I" & i).Value = Nz(rs1![High Range], 0)
.Range("J" & i).Value = Nz(rs1![Low Range], 0)
.Range("K" & i).Value = Nz(rs1![% Spent], 0)
.Range("L" & i).Value = Nz(rs1!Explanation, "")
.Range("M" & i).Value = Nz(rs1!Status, "")

'.Range("K" & i).HorizontalAlignment = xlCenter
.Columns("K").HorizontalAlignment = xlCenter
.Rows(i).RowHeight = 25


i = i + 1
rs1.MoveNext

Loop

.Range("B" & i, "E" & i).Merge
.Range("B" & i).Value = "Total"
.Range("B" & i).HorizontalAlignment = xlCenter

'Sum Totals
.Range("G" & i).Formula = "=SUM(G3:G" & i - 1
.Range("H" & i).Formula = "=SUM(H3:H" & i - 1
.Range("I" & i).Formula = "=SUM(I3:I" & i - 1
.Range("J" & i).Formula = "=SUM(J3:J" & i - 1
.Range("K" & i).Formula = IIf(.Range("H" & i) = 0, IIf(.Range("G" & i) = 0, 0, .Range("G" & i)), (.Range("G" & i) / .Range("H" & i)))
.Range("A" & i & ":F" & i).Cells.Font.Bold = True

'Total Row Format
.Range("B" & i & ":L" & i).Cells.Font.Size = 12
.Range("B" & i & ":L" & i).Cells.Font.Bold = True
.Range("B" & i & ":L" & i).Interior.Color = RGB(191, 191, 191)
.Rows(i).RowHeight = 25
.Range("B" & i & ":L" & i).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
.Range("B" & i & ":L" & i).Borders(xlEdgeBottom).Weight = XlBorderWeight.xlMedium
'Grid
.Range("B3:L" & i - 0).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
.Range("C3:L" & i + 0).Borders(xlEdgeRight).Weight = XlBorderWeight.xlMedium
.Range("B3:L" & i + 0).Borders(xlEdgeLeft).Weight = XlBorderWeight.xlMedium
.Range("B3:L" & i - 0).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous


.Range("B3", "B" & i - 1).Merge
.Range("C3", "C" & i - 1).Merge
.Range("B3").WrapText = True
.Range("C3").WrapText = True
.Range("B3").VerticalAlignment = xlCenter
.Range("B3").Cells.Font.Bold = True
.Range("C3").VerticalAlignment = xlCenter
.Range("C3").Cells.Font.Bold = True

'.Range("N3" & i).Formula = IIf(.Range("M3" & i) = "RED", .Range("N3" & i).Interior.Color = RGB(255, 53, 53), .Range("N3" & i).Interior.Color = RGB(0, 176, 80))
'.Range("D" & i).Formula =iif(.Range("M" & i)=""RED"",.Range("D" & i).Interior.Color = RGB(255, 53, 53), .Range("D" & i).Interior.Color = RGB(0, 176, 80))
'.Range("M" & i).Formula = IIf(Range("M" & i) = "RED", Interior.Color = RGB(255, 53, 53), Interior.Color = RGB(0, 176, 80))


End With

xlSheet.Range("A1").Activate

Next intCounterAVP


'With Range("D:M" & i)
'.FormatConditions.Add xlCellValue, xlEqual, "Red"
'With .FormatConditions(1)
'.Interior.Color = RGB(255, 53, 53)

'End With
'End With



SubExit:
On Error Resume Next
'messagebox = "Exit SUB"
DoCmd.Hourglass False
DoCmd.Beep
xlApp.Visible = True
rs1.Close
Set rs1 = Nothing
DoCmd.SetWarnings True
xlApp.Application.DisplayAlerts = True
'MsgBox "done"

Exit Sub

SubError:
MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, _
"An error occurred"
GoTo SubExit




End Sub

[ItsMe]

Specific to the formatting issue, you will probably need to manage the formatting inside of your loop. So, before your MoveNext, format the cells in the other D through L. You are only formatting 9 cells at a time, within the loop and for that Row.

Now the trick. You have a variable. rs1!Status

With that you should be able to hard code the Interior.Color using a Select Case.

so something like (double check the code syntax I am providing) ...

Select Case rs1!Status

Case "Red"
'Format code here
Case "Black"
'Format code here
Case "Orange"
'Format code here

Case Else
'Format code here
End Select

[RobotronX]

Wow you rock!!!
Thank you

That was a super simple explanation
And calling status that way I can take it off the final report and just use the color!

Here is what I added(I need to fix the RGB color values)


Select Case rs1!Status

Case "Red"
.Range("D" & i & ":L" & i).Interior.Color = RGB(255, 53, 53)
Case "Green"
.Range("D" & i & ":L" & i).Interior.Color = RGB(0, 191, 191)
Case "Orange"
.Range("D" & i & ":L" & i).Interior.Color = RGB(191, 0, 191)

Case Else
.Range("D" & i & ":L" & i).Interior.Color = RGB(0, 0, 0)
End Select



i = i + 1
rs1.MoveNext

[ItsMe]

It seems like you got it. Glossing over your code, it seems you are doing well. I would have to spend some time to recommend refactoring. The one exception would be to break your code up into several procedures. But you can wait on calling subs and functions, etc. until after you get more comfortable. Nice work.

[ssanfu]

Be aware that "SQL" is a reserved word in Access (it is a property of a form/query).
Better names would be "sSQL" or "strSQL"

[ItsMe]

Nice catch, Steve. Although, everyone knows that the only option is strSQL.