Solved: Conditional Formatting on Spreadsheet

[James Niven]

Hi All,

I have spent a few days on this trying to make it work but no luck.

What I am looking for is I run this macro on the spreadsheet which is used to send out to the field associates. They will in turn fill in the column with July (blank column starting at P) with a current meter read under and then all other columns with July in the heading. I want to be able to highlight the cell with a color and make bold which shows the associate onsite that they have entered a value lower than last month (the column to the left O and all other columns to the left of the blank.)

Can someone please assist me here, thanks in advance to those who offer help!

James Niven

[Bob Phillips]

I cannot see which columns are being compared? P is not blank.

[James Niven]

XLD,

If you run the macro, you will see the blank columns appear, there should be 7 of them.


James Niven

[Bob Phillips]

Sub MetersToField()

'******************************************************************
'* This macro is to format the Meters to the Field spreadsheet *
'* which the docucare reps fills in and emails back. The data is *
'* received from the Enterprise Database. *
'* *
'* Written by James Niven 03/26/2009 *
'******************************************************************

'Declare Variables
Dim wksQryMetersSendout As Worksheet
Dim uInput As String
Dim C As Range

'Set Worksheet Name
Set wksQryMetersSendout = ThisWorkbook.Worksheets("QryMeters Send out List")

'Get Input from User
uInput = InputBox("Enter the Current Month?", "Meters to Field")

'Insert two blank rows
Range("1:2").EntireRow.Insert

'Spreadsheet Formatting
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
.LeftMargin = Application.InchesToPoints(0.1)
.RightMargin = Application.InchesToPoints(0.1)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintQuality = 600
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.Zoom = 60
.PrintErrors = xlPrintErrorsDisplayed
End With

'Insert/Format Blank Columns
Call Setupcells(Range("O3"), wksQryMetersSendout, uInput)
Call Setupcells(Range("Q3"), wksQryMetersSendout, uInput)
Call Setupcells(Range("S3"), wksQryMetersSendout, uInput)
Call Setupcells(Range("U3"), wksQryMetersSendout, uInput)
Call Setupcells(Range("W3"), wksQryMetersSendout, uInput)
Call Setupcells(Range("Y3"), wksQryMetersSendout, uInput)
Call Setupcells(Range("AA3"), wksQryMetersSendout, uInput)

Columns("B:D").ColumnWidth = 3
Columns("O:AB").ColumnWidth = 7
ActiveWindow.SelectedSheets.PrintPreview

End Sub

Private Sub Setupcells(ByRef rng As Range, ByRef sh As Worksheet, MonthName As String)
Dim CFrng As Range
With rng

.Select
.EntireColumn.NumberFormat = "#,##0;[Red]#,##0"
.Offset(, 1).EntireColumn.Insert
.Offset(, 1).NumberFormat = "MMMM"
.Offset(, 1).Value = MonthName

'Conditional Format
Set CFrng = Intersect(sh.Columns(.Column + 1), sh.UsedRange).Cells
CFrng.FormatConditions.Delete
CFrng.FormatConditions.Add Type:=xlExpression, _
Formula1:="=AND(" & .Address(False, False) & "<>""""," & _
.Offset(0, -1).Address(False, False) & ">" & .Address(False, False) & ")"
CFrng.FormatConditions(1).Font.Bold = True
CFrng.FormatConditions(1).Interior.ColorIndex = 6
End With
End Sub

[James Niven]

XLD,

You are the Lord of VBA, this is exactly what I am after, thank you so much for your time and effort.

I most certianly need to learn more!!

James Niven

[James Niven]

Hi Guys,

I seem to have a new issue cropping up with this.

Here is the code I am using:

Sub MetersToField()

'******************************************************************
'* This macro is to format the Meters to the Field spreadsheet *
'* which the docucare reps fills in and emails back. The data is *
'* received from the Enterprise Database. *
'* *
'* *
'******************************************************************

'Declare Variables
Dim wksQryMetersSendout As Worksheet
Dim uInput As String
Dim C As Range

'Set Worksheet Name
Set wksQryMetersSendout = ThisWorkbook.Worksheets("QryMeters Send out List")

'Get Input from User
uInput = InputBox("Enter the Current Month?", "Meters to Field")

'Insert two blank rows
Range("1:2").EntireRow.Insert

'Spreadsheet Formatting
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
.LeftMargin = Application.InchesToPoints(0.1)
.RightMargin = Application.InchesToPoints(0.1)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintQuality = 600
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.Zoom = 60
.PrintErrors = xlPrintErrorsDisplayed
End With

'Insert/Format Blank Columns
Call Setupcells(Range("O3"), wksQryMetersSendout, uInput)
Call Setupcells(Range("Q3"), wksQryMetersSendout, uInput)
Call Setupcells(Range("S3"), wksQryMetersSendout, uInput)
Call Setupcells(Range("U3"), wksQryMetersSendout, uInput)
Call Setupcells(Range("W3"), wksQryMetersSendout, uInput)
Call Setupcells(Range("Y3"), wksQryMetersSendout, uInput)
Call Setupcells(Range("AA3"), wksQryMetersSendout, uInput)

Columns("B:D").ColumnWidth = 3
Columns("O:AB").ColumnWidth = 7
ActiveWindow.SelectedSheets.PrintPreview

End Sub

Private Sub Setupcells(ByRef rng As Range, ByRef sh As Worksheet, MonthName As String)
Dim CFrng As Range
With rng

.Select
.EntireColumn.NumberFormat = "#,##0;[Red]#,##0"
.Offset(, 1).EntireColumn.Insert
.Offset(, 1).NumberFormat = "MMMM"
.Offset(, 1).Value = MonthName

'Conditional Format
Set CFrng = Intersect(sh.Columns(.Column + 1), sh.UsedRange).Cells
CFrng.FormatConditions.Delete
CFrng.FormatConditions.Add Type:=xlExpression, _
Formula1:="=AND(" & .Address(False, False) & "<>""""," & _
.Offset(0, -1).Address(False, False) & ">" & .Address(False, False) & ")"
CFrng.FormatConditions(1).Font.Bold = True
CFrng.FormatConditions(1).Interior.ColorIndex = 6
End With
End Sub

When I run this I get the following error.

"Run-time error '91'
Object variable or with block variable not set

Sometime this will run and other times I receive this error, what gives?

Please see the attachment.

Thanks

James Niven

[mdmackillop]

On which line does it fail?

[James Niven]

mdmackillop,

When you run the code, it goes most of the way through the actions, and it seems to die at column 21.

Hope this helps!

James