lookup and conditional formatting with VBA

[goodwin57]

Using excel 2003.
I'm trying to set some conditional formatting up to colour the cells of Grades entered, when they are entered, compared to a target grade.
I have a range on another sheet which I would normally use for a vlookup giving possible grades, and the points they are worth. Along each row are a selection of dates, each one having a grade. Down the columns there are other rows of grades for different subjects. I've written something, but when I try to run it (from the VBE) it falls over to a 1004 error. Code as below. Any suggestions would be very much appreciated, kind regards

Simon


Option Explicit
Sub ColorCoding()
Dim Scores As Variant
Dim Grade As Variant
Dim MyArray As Variant
Dim GradeRow As Variant
Dim Width As Long
Dim RowCount As Long
Dim Target As Variant
Dim RowIndex As Long
Dim ColumnIndex As Long
Dim irows As Long
Dim Kind As String




irows = Range("Subjects").Columns.Count * 2
Width = Range("Dates").Columns.Count
Scores = Range("Points")
GradeRow = Range("$E" & RowIndex, Range("$E" & RowIndex).Offset(0, Width))
RowIndex = 2
ColumnIndex = 0
MyArray = Range("A1", Range("A1").Offset(Width, irows))


'ENTER CODE HERE on data entry into the range MyArray (on click or something) activate this macro


KindLabel: Range("$B" & RowIndex).Activate


Kind = ActiveCell.Value
If Kind = "Grade" Then
' Translate the Grade to a number
Scores.Find("$D" & RowIndex).Activate
ActiveCell.Offset(0, 1) = Target
' Translate the Target Grade to a number
Compare: Scores.Find("$E" & RowIndex).Activate
ActiveCell.Offset(0, ColumnIndex) = Grade
If Grade < Target Then
ActiveCell.Interior.ColorIndex = 3
If Grade > Target Then
ActiveCell.Interior.ColorIndex = 5
If Grade = Target Then
ActiveCell.Interior.ColorIndex = 4
End If
End If
End If
End If
ColumnIndex = ColumnIndex + 1
If ColumnIndex < Width Then GoTo Compare
RowIndex = RowIndex + 1
If ColumnIndex < irows + 2 Then GoTo KindLabel


' If ActiveCell.Value = "Motivation" Then code will go here

End Sub

[Bob Phillips]

That is because RowIndex is not set, it has a value of 0, and there is no row 0.

But ditch the VBA, use conditional formatting, you only have 3 values.

[goodwin57]

Thanks for the response.
The RowIndex/ColumnIndex is used to offset the cells - so my understanding is that it can be set to 0 (as we can offset by 0, by remaining in the same position).

The reason I think I need to use VBA rather than conditional formatting is that there are many grades worth various points, and they need translating into those points before I can run a conditional formatting comparison such as if Grade < Target Then red. and so on. I hope that clarifies, cheers,

Simon

[Simon Lloyd]

if you are only using 3 different colours then you don't need VBA to achieve it, excels own conditional formatting should suffice!

[Simon Lloyd]

Threads Merged, Duplicate post!

[Bob Phillips]

Thanks for the response.
The RowIndex/ColumnIndex is used to offset the cells - so my understanding is that it can be set to 0 (as we can offset by 0, by remaining in the same position).



GradeRow = Range("$E" & RowIndex, Range("$E" & RowIndex).Offset(0, Width))


That is not using RowIndex as an offset, so a value of 0 is invalid.

[Simon Lloyd]

Cross posted here (http://www.excelforum.com/showthread.php?t=648357) and at least here (http://www.theofficeexperts.com/forum/showthread.php?t=9599) Simon, read the link in my signature about cross posting!
Edit: cross posted here also (http://mrexcel.com/forum/showthread.php?t=327327)

[goodwin57]

Sorry, my impression as a reader has been that different sites have different users and thus responses - it is now of course apparent this isn't the case - I won't cross post unless necessary again.

On the topic of the post, it isn't clear to me how, using the standard conditional formatting, I can compare grades with each other, as excel doesn't recognise A as being higher than B (for example). And indeed, for some courses I have grades(and targets) like "pass" or "merit" with numeric values associated. If anyone can tell me how to use this in standard conditional formatting I'd be happy to use it :).

The RowIndex isn't set to 0 it's set to 2 so I think that should be fine code wise. The final ColumnIndex should be RowIndex though.

[Simon Lloyd]

Which forum do you want to continue this questioning with?

EDIT: goodwin57 has PM'd me and apologised and would like to continue with help here rather than any other forum, question already deleted at Excel Forum

[goodwin57]

To be clear about what method I've tried on conditional formatting, I have a named range (points) with the points each grade is worth in, and have tried using formulae in the conditional formatting e.g.:

Formula Is: ="vlookup(E2,Points,2,FALSE)=(vlookup(d2,M9:N12,2,FALSE)"

with no effect.
In this case E2 is the grade and D2 the target, if equal it should change E2 green.

cheers

[Simon Lloyd]

Can you supply a sample workbook as it's difficult to visualise what you are trying to achieve or what you are working with.

[goodwin57]

Sample workbook attached. The sheet of interest is the "template" sheet.Where B column = "grade" the grades on that row should be compared and the cells coloured as compared to the grades in the "Target" column. I haven't put data validation on yet (that's my next task). Hope this helps, obviously ask if further clarification is required :)

[Bob Phillips]

The RowIndex isn't set to 0 it's set to 2 so I think that should be fine code wise. The final ColumnIndex should be RowIndex though.

Let me quote you first few lines of code as it appears in our first post



Sub ColorCoding()
Dim Scores As Variant
Dim Grade As Variant
Dim MyArray As Variant
Dim GradeRow As Variant
Dim Width As Long
Dim RowCount As Long
Dim Target As Variant
Dim RowIndex As Long
Dim ColumnIndex As Long
Dim irows As Long
Dim Kind As String

irows = Range("Subjects").Columns.Count * 2
Width = Range("Dates").Columns.Count
Scores = Range("Points")
GradeRow = Range("$E" & RowIndex, Range("$E" & RowIndex).Offset(0, Width))
RowIndex = 2


Yes you do set RowIndex to 2, but after you have used it before it is set, i.e. when it is 0.

Keep ignoring the advice, and we will ignore you.

[goodwin57]

xld - sorry, I wasn't ignoring advice before I just didn't see where the error lay. I've now altered that piece of code such that the RowIndex = 2 appears before it is used. Thank you for the help.

I realised when I woke up this morning that this code will be very inefficient unless it actually sets the conditional formatting within the workbook. Otherwise, I'll probably be aiming to set the macro to activate on a cell value changing within my data-entry range. But with this code, that would result in all values in that range being checked. Given that those which were formatted by the macro previously should retain that formating, this results in far more comparisons than are necessary.

So, I will be rewriting the code to something of the form:
On cell value changing, format cell
Check the value in the B column, on the activecells row. If it is "Grade" then compare the activecell to the target using the vlookup.

Note that although this is a significant change, I think I still need to use the same if...then conditional formatting setup I've been using. Can anyone see any obvious reasons why this wouldn't work? Thank you for any further advise you can offer.

Simon

[Bob Phillips]

Okay, so you have fixed the 1004 error. Is it now working?

[goodwin57]

Problem still exists. Below is the code as it now stands. I've also altered the 'find' code to what I think is the correct syntax. I haven't had a chance to alter the code as above, I'll post any further changes as soon as I can. Thank you for your help,

Simon


Option Explicit
Sub ColorCoding()
Dim Scores As Variant
Dim Grade As Variant
Dim MyArray As Variant
Dim GradeRow As Variant
Dim WidthDist As Long
Dim RowCount As Long
Dim Target As Variant
Dim RowIndex As Long
Dim ColumnIndex As Long
Dim irows As Long
Dim Kind As String
Dim ImHere As Variant
irows = Range("Subjects").Columns.Count * 2
WidthDist = Range("Dates").Columns.Count
Scores = Range("Points")
RowIndex = 2
GradeRow = Range("$E" & RowIndex, Range("$E" & RowIndex).Offset(0, WidthDist))
ColumnIndex = 0
MyArray = Range("A1", Range("A1").Offset(WidthDist, irows))
'ENTER CODE HERE on data entry into the range MyArray (on click or something) activate this macro
KindLabel: Range("$B" & RowIndex).Activate
Kind = ActiveCell.Value
If Kind = "Grade" Then
' Translate the Target to a number
Set ImHere = Range("Points").Find(What:=Range("$D" & RowIndex), LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Range(ImHere).Activate
ActiveCell.Offset(0, 1) = Target
' Translate the Grade to a number
Compare:
Set ImHere = Range("Points").Find(What:=Range("$E" & RowIndex), LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Range(ImHere).Activate
ActiveCell.Offset(0, 1) = Grade
If Grade < Target Then
ActiveCell.Interior.ColorIndex = 3
If Grade > Target Then
ActiveCell.Interior.ColorIndex = 5
If Grade = Target Then
ActiveCell.Interior.ColorIndex = 4
End If
End If
End If
End If
ColumnIndex = ColumnIndex + 1
If ColumnIndex < WidthDist Then GoTo Compare
RowIndex = RowIndex + 1
If RowIndex < irows + 2 Then GoTo KindLabel

End Sub

[goodwin57]

[previous post deleted within 15 minutes, I hope no one had worked with it]
Code fixed to produce no errors. However, the formatting I was hoping would execute, has not done so. The code appears to run fine (on grade rows at least) but doesn't change the cell colour. Any suggestions as to why would be much appreciated,
Regards

Simon



Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim VRange As Range
Dim Scores As Range
Dim Grade As Variant
Dim MyArray As Variant
Dim GradeRow As Variant
Dim WidthDist As Long
Dim RowCount As Long
Dim Targ As Variant
Dim RowIndex As Long
Dim ColumnIndex As Long
Dim irows As Long
Dim Kind As String
Dim FindTarget As Range
Dim FindGrade As Range
Dim MyCell As Object


Set MyCell = ActiveCell 'set the changed cell to a variable (which will be kept)
'the following 5 lines check the change was in the area im interested in
WidthDist = Worksheets("Dashboard").Range("Dates").Columns.Count
irows = Worksheets("Dashboard").Range("Subjects").Rows.Count * 2
Set Scores = Worksheets("Dashboard").Range("Points") 'Range(Sheets("Dashboard").Range("Points"))
Set VRange = Range("$E$2", Range("$E$2").Offset(WidthDist, irows))
If Not Intersect(Target, VRange) Is Nothing Then


RowIndex = ActiveCell.Row


KindLabel: Range("$B" & RowIndex).Activate


Kind = ActiveCell.Value
If Kind = "Grade" Then
' Translate the Target to a number:
Set FindTarget = Worksheets("Dashboard").Range("Points").Find(What:=Range("D" & RowIndex), LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
'Range(FindTarget).Activate
Targ = ActiveCell.Offset(0, 1)
' Translate the Grade to a number:
Compare:
Set FindGrade = Worksheets("Dashboard").Range("Points").Find(What:=MyCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
'Range(FindGrade).Activate
Grade = ActiveCell.Offset(0, 1)
If Grade < Targ Then
MyCell.Interior.ColorIndex = 3
If Grade > Targ Then
MyCell.Interior.ColorIndex = 5
If Grade = Targ Then
MyCell.Interior.ColorIndex = 4
End If
End If
End If


If Kind = "Motivation" Then


If MyCell < 5 Then
MyCell.Interior.ColorIndex = 3
If MyCell >= 7 Then
MyCell.Interior.ColorIndex = 4
If MyCell < 7 Then
MyCell.Interior.ColorIndex = 6
Else: MyCell.Interior.ColorIndex = 19
End If
End If
End If
End If
End If
End If
End Sub

[goodwin57]

Note that a somewhat related thread on selecting an area for formatting exists here:
http://www.vbaexpress.com/forum/showthread.php?p=150742#post150742

A more recent full code is on that thread and copied below. This is the methodology I am now exploring (slowly).



Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim VRange As Range
Dim Scores As Range
Dim Grade As Integer
Dim WidthDist As Integer
Dim Targ As Integer
Dim MyList As Integer
Dim Kind As String
Dim FindTarget As Range
Dim FindGrade As Range
Dim MyCell As String
Dim iValue As Long
Dim iColor As Integer
Dim Mycolor As Integer
Dim MyOffset As String


MyCell = Target.Address
'If Target.Value = "" Then
'Target.Interior.ColorIndex = 36
'GoTo FinishLine
'ElseIf Target.Value <> "" Then
'set the changed cell to a variable (which will be kept)
'the following 5 lines check the change was in the area im interested in
WidthDist = Worksheets("Dashboard").Range("Dates").Columns.Count
MyList = (Worksheets("Dashboard").Range("Subjects").Rows.Count * 2)
'MyOffset = Range("$E$2").Offset(WidthDist, MyList).Address
Set Scores = Worksheets("Dashboard").Range("Points")
Set VRange = Range("$E$2").Resize(MyList, WidthDist).Activate


If Not Intersect(Target, VRange) Is Nothing Then


KindLabel: Range("$B" & Target.Row).Activate
If ActiveCell.Value = "Grade" Then
GoTo GradeWork
ElseIf ActiveCell.Value = "Motivation" Then
GoTo MotivationWork


GradeWork:
' Translate the Target to a number:
Set FindTarget = Worksheets("Dashboard").Range("Points").Find(What:=Range("D" & Target.Row), LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
'Range(FindTarget).Activate
Targ = ActiveCell.Offset(0, 1).Select.Value
' Translate the Grade to a number:
Compare:
Set FindGrade = Worksheets("Dashboard").Range("Points").Find(What:=Target, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
'Range(FindGrade).Activate
Grade = ActiveCell.Offset(0, 1).Select.Value

iValue = (Grade - Targ)
Select Case iValue
Case Is > 0
iColor = 3
Case Is = 0
iColor = 4
Case Is < 0
iColor = 8
End Select

Range(MyCell).Activate
Target.Interior.ColorIndex = iColor
Range(MyCell).Activate
End If
GoTo FinishLine


MotivationWork:
Select Case Target.Value
Case 1 To 4
Mycolor = 3
Case 5 To 6
Mycolor = 6
Case 7 To 9
Mycolor = 43
End Select
Range(MyCell).Activate
Target.Interior.ColorIndex = Mycolor
Range(MyCell).Activate
End If
FinishLine:
End Sub