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