Solved: Help required for Excel VBA query

[LowSociety]

Hi,
I have a spreadsheet with several named ranges:-
A2:A100 Trainer_Name
B2:B200 Start_Date
C2:C200 End_Date
D2200 Course_Name

I use the following formula on the worksheet to display a 1 value in the cell if a course is taking place by a trainer on a given date or a 2value if the dates are over a weekend:-
=SUMPRODUCT(($G5=Trainer_Name)*(Start_Date<=H$4)*(End_Date>=H$4))+IF(WEEKDA Y(H$4,2)>5,2,0)

I need a macro to look at all the cells in the worksheet that display a value 1 (e.g. a course is taking place) and insert a comment in the appropriate cell by looking up the appropriate course from the named range in cells D2200

Can this be done, and if so, can anyone please point me in the right direction? My VBA skills are very limited.

Many thanks for taking the time to look at this, and any help suggested is greatfully acknowledged.

Regards,

Gary

[lucas]

Hi Lo,
could you post a small example file...I'm not following you on this part:

and insert a comment in the appropriate cell by looking up the appropriate course from the named range in cells D2200

[LowSociety]

Sorry if my original post didn't make much sense. Here's an attachment which contains an example.

Thanks,

Gary

[Bob Phillips]

[vba]

Sub AddComments()
Const NAMES As String = "A1:A20" '<=== change to suit
Const SDATES As String = "B1:B20" '<=== change to suit
Const EDATES As String = "C1:C20" '<=== change to suit
Const COURSES As String = "D120" '<=== change to suit
Dim iLastRow As Long
Dim iLastCol As Long
Dim i As Long, j As Long
Dim sCourse As String
Dim sFormula As String

With ActiveSheet.Range("Results")
iLastRow = .Offset(1, 0).End(xlDown).Row
iLastCol = .Offset(0, 1).End(xlToRight).Column
For i = 2 To iLastRow
For j = 2 To iLastCol
If .Offset(i - 1, j - 1).Value = 1 Then
sFormula = "=INDEX(" & COURSES & ",MATCH(1,(" & _
"(" & .Offset(i - 1, 0).Address & "=" & NAMES & ")*" & _
"(" & .Offset(0, j - 1).Address & ">=" & SDATES & ")*" & _
"(" & .Offset(0, j - 1).Address & "<=" & EDATES & ")),0))"
sCourse = ActiveSheet.Evaluate(sFormula)
On Error Resume Next
.Offset(i - 1, j - 1).Comment.Delete
On Error GoTo 0
.Offset(i - 1, j - 1).AddComment sCourse
End If
Next j
Next i
End With
End Sub
[/vba]

[LowSociety]

Thank you for your reply, however I couldn't get the code to work. Am I doing something wrong?

I copied and pasted the provided code into a new module.
In Excel 2003 at work using a similar version to the example provided, the code stops with an error at

With ActiveSheet.Range("Results")

In Excel 2007 using the example previously attached, I simply get a dialog box displaying "400".

Sorry to ask such stupid questions, and thanks again for any help or suggestions provided.

[Bob Phillips]

Sorry, I forgot to mention that I named the full range to commented, G1:U7 in your workbook, as Results.

[Aussiebear]

G'day Low,

Is the range "Results" named properly?

[Aussiebear]

Oops sorry Bob, your reply wasn't showing when I typed.

[LowSociety]

Thanks for that. I wondered what "Results" was referring to in the code provided.

I now get a type mismatch error in the line

If .Offset(i - 1, j - 1).Value = 1 Then

[Bob Phillips]

How odd, it worked fine in 2000, but doesn't in 2003. Try this variation [vba] Sub AddComments() Const NAMES As String = "A1:A20" '

[LowSociety]

Do you mean just getting rid of the comments at the end of the first few lines in the code? If so, I've tried that and it makes no difference - sorry!

[Bob Phillips]

No, that post didn't come out too well so hopefully it will be better on a different machine

[vba]

Sub AddComments()
Const NAMES As String = "A1:A20" '<=== change to suit
Const SDATES As String = "B1:B20" '<=== change to suit
Const EDATES As String = "C1:C20" '<=== change to suit
Const COURSES As String = "D120" '<=== change to suit
Dim iLastRow As Long
Dim iLastCol As Long
Dim i As Long, j As Long
Dim sCourse As String
Dim sFormula As String

With ActiveSheet.Range("Results").Cells(1, 1)
iLastRow = .Offset(1, 0).End(xlDown).Row
iLastCol = .Offset(0, 1).End(xlToRight).Column
For i = 2 To iLastRow
For j = 2 To iLastCol
If .Offset(i - 1, j - 1).Value = 1 Then
sFormula = "=INDEX(" & COURSES & ",MATCH(1,(" & _
"(" & .Offset(i - 1, 0).Address & "=" & NAMES & ")*" & _
"(" & .Offset(0, j - 1).Address & ">=" & SDATES & ")*" & _
"(" & .Offset(0, j - 1).Address & "<=" & EDATES & ")),0))"
sCourse = ActiveSheet.Evaluate(sFormula)
On Error Resume Next
.Offset(i - 1, j - 1).Comment.Delete
On Error GoTo 0
.Offset(i - 1, j - 1).AddComment sCourse
End If
Next j
Next i
End With
End Sub
[/vba]

[LowSociety]

Hi,

I now get run-time error 1004
Application-defined or object-defined error

at the same line of code.

[Bob Phillips]

Works for me

[LowSociety]

Hi,
It's strange - the attachment works for me too, but my own version didn't. I can't see where I've gone wrong, other than missing out Option Explicit at the top (which didn't seem to make any difference anyway).

No doubt, when I've looked more in depth, I'll be able to establish what my mistake was.

Thanks to all those who have contributed to this thread - I really appreciate the time and trouble you have taken to help me.

[Bob Phillips]

You could post your non-working workbook.