PDA

View Full Version : Solved: Help required for Excel VBA query



LowSociety
03-26-2007, 06:30 PM
Hi,
I have a spreadsheet with several named ranges:-
A2:A100 Trainer_Name
B2:B200 Start_Date
C2:C200 End_Date
D2:D200 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(WEEKDAY(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 D2:D200

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
03-26-2007, 06:44 PM
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 D2:D200

LowSociety
03-26-2007, 07:10 PM
Sorry if my original post didn't make much sense. Here's an attachment which contains an example.

Thanks,

Gary

Bob Phillips
03-27-2007, 01:58 AM
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 = "D1:D20" '<=== 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

LowSociety
03-27-2007, 01:00 PM
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
03-27-2007, 01:05 PM
Sorry, I forgot to mention that I named the full range to commented, G1:U7 in your workbook, as Results.

Aussiebear
03-27-2007, 01:08 PM
G'day Low,

Is the range "Results" named properly?

Aussiebear
03-27-2007, 01:09 PM
Oops sorry Bob, your reply wasn't showing when I typed.

LowSociety
03-27-2007, 01:15 PM
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
03-27-2007, 01:44 PM
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
03-27-2007, 01:51 PM
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
03-27-2007, 01:55 PM
No, that post didn't come out too well so hopefully it will be better on a different machine



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 = "D1:D20" '<=== 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

LowSociety
03-27-2007, 02:00 PM
Hi,

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

at the same line of code.

Bob Phillips
03-27-2007, 02:52 PM
Works for me

LowSociety
03-27-2007, 06:07 PM
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
03-28-2007, 12:38 AM
You could post your non-working workbook.