On Error Issues

[samuelimtech]

Hi all,

firstly thanks for any help. Ive posted my whole code as an issue maybe somewhere else.
as you can see in my code "Calendar" is a string that i convert to a date and if the cell is blank got to an error handler, this works for some loops but not all the time

p.s you will notice the Cdate functions at the bottom of the code are not correct at all, I plan to mimic what is happening at the top.

thanks for any help


Private Sub text4comment()
Dim DiaryLoop As Integer
Dim start As Long
Dim Calendar As String
Dim column As Integer
Dim row As Integer
Dim finalrow As Integer
Sheets("Calendar").Cells.ClearComments 'Clear Comments
For column = 4 To 34 ' collumn loop counter in calendar sheet
On Error GoTo Errorhandler1
For row = 7 To 29 ' row loop counter in calendar sheet
'Loop counter
'start = Sheets("Alan").Cells(DiaryLoop, 2)
On Error GoTo Errorhandler2
Calendar = Sheets("Calendar").Cells(row, column)
Calendar = CDate(Calendar)
If Calendar <> "" Then
finalrow = Sheets("Alan").Range("A" & Rows.Count).End(xlUp).row
For DiaryLoop = 7 To finalrow
Dim StartDate As String ' start date in diary
StartDate = Sheets("Alan").Cells(DiaryLoop, 2).Value
If Calendar = StartDate Then ' if calendar date mathes the date in the the diary
Dim Comm As Comment
Dim TextAlan As String
Dim startTime As String
If Calendar = Sheets("Alan").Cells(DiaryLoop, 4).Value Then ' if the end date is the same as the start Date
startTime = Format(Sheets("Alan").Cells(DiaryLoop, 3).Value, "hh:mm")
TextAlan = "AHi-" & Sheets("Alan").Cells(DiaryLoop, 1).Value & " " & Format(Sheets("Alan").Cells(DiaryLoop, 3).Value, "hh:mm") & "-" & Format(Sheets("Alan").Cells(DiaryLoop, 5).Value, "hh:mm")
'these silly long string define the text in the comment box,structure = subject-start time- end time
On Error Resume Next
If Sheets("Calendar").Cells(row, column).Comment Is Nothing Then 'check if there is NOT a comment
Sheets("Calendar").Cells(row, column).AddComment TextAlan
Sheets("Calendar").Cells(row, column).Comment.Visible = False
Sheets("Calendar").Cells(row, column).Comment.Shape.Width = 300
Sheets("Calendar").Cells(row, column).Comment.Shape.Height = 200
Else ' if there is a comment in the cell add to it
Dim holder As String
holder = Sheets("Calendar").Cells(row, column).Comment.Text 'used to save the text already in the comment
Sheets("Calendar").Cells(row, column).Comment.Delete
Sheets("Calendar").Cells(row, column).AddComment holder & Chr(10) & TextAlan
Sheets("Calendar").Cells(row, column).Comment.Visible = False
Sheets("Calendar").Cells(row, column).Comment.Shape.Width = 300
Sheets("Calendar").Cells(row, column).Comment.Shape.Height = 200
End If
Else
TextAlan = "AHi-" & Sheets("Alan").Cells(DiaryLoop, 1).Value & " " & Format(Sheets("Alan").Cells(DiaryLoop, 3).Value, "hh:mm") & "-" & Sheets("Alan").Cells(DiaryLoop, 4).Value & " " & Format(Sheets("Alan").Cells(DiaryLoop, 5).Value, "hh:mm")
'if the end date is different from start date, structure = subject - starttime- end date - end time
On Error Resume Next
If Sheets("Calendar").Cells(row, column).Comment Is Nothing Then 'check if there is NOT a comment
Sheets("Calendar").Cells(row, column).AddComment TextAlan
Sheets("Calendar").Cells(row, column).Comment.Visible = False
Sheets("Calendar").Cells(row, column).Comment.Shape.Width = 300
Sheets("Calendar").Cells(row, column).Comment.Shape.Height = 200
Else 'if there is a comment add to it
holder = Sheets("Calendar").Cells(row, column).Comment.Text 'used to save the text already in the comment
Sheets("Calendar").Cells(row, column).Comment.Delete
Sheets("Calendar").Cells(row, column).AddComment holder & Chr(10) & TextAlan
Sheets("Calendar").Cells(row, column).Comment.Visible = False
Sheets("Calendar").Cells(row, column).Comment.Shape.Width = 300
Sheets("Calendar").Cells(row, column).Comment.Shape.Height = 200
End If
End If
Else
Dim EndDate As String
EndDate = Sheets("Alan").Cells(DiaryLoop, 4).Value
If CDate(Calendar) > CDate(StartDate) And CDate(Calendar) <= CDate(EndDate) Then

startTime = Format(Sheets("Alan").Cells(DiaryLoop, 3).Value, "hh:mm")

TextAlan = "AHi-" & Sheets("Alan").Cells(DiaryLoop, 1).Value & " - " & StartDate & " " & Format(Sheets("Alan").Cells(DiaryLoop, 3).Value, "hh:mm") & "-" & Sheets("Alan").Cells(DiaryLoop, 4).Value & " " & Format(Sheets("Alan").Cells(DiaryLoop, 5).Value, "hh:mm")
'if the end date is different from start date, structure = subject - starttime- end date - end time
On Error Resume Next
If Sheets("Calendar").Cells(row, column).Comment Is Nothing Then 'check if there is NOT a comment
Sheets("Calendar").Cells(row, column).AddComment TextAlan
Sheets("Calendar").Cells(row, column).Comment.Visible = False
Sheets("Calendar").Cells(row, column).Comment.Shape.Width = 300
Sheets("Calendar").Cells(row, column).Comment.Shape.Height = 200
Else 'if there is a comment add to it
holder = Sheets("Calendar").Cells(row, column).Comment.Text 'used to save the text already in the comment
Sheets("Calendar").Cells(row, column).Comment.Delete
Sheets("Calendar").Cells(row, column).AddComment holder & Chr(10) & TextAlan
Sheets("Calendar").Cells(row, column).Comment.Visible = False
Sheets("Calendar").Cells(row, column).Comment.Shape.Width = 300
Sheets("Calendar").Cells(row, column).Comment.Shape.Height = 200

End If
Else
End If
End If
Next
Else
End If
Errorhandler2:
Next
Errorhandler1:
Next

[Bob Phillips]

I would dispense with that horrible error handling and test the data


Private Sub text4comment()
Dim wsCalendar As Worksheet
Dim Comm As Comment
Dim DiaryLoop As Long
Dim start As Long
Dim Calendar As Date
Dim column As Long
Dim row As Long
Dim finalrow As Long
Dim TextAlan As String
Dim StartDate As String ' start date in diary
Dim startTime As String
Dim EndDate As String

Set wsCalendar = Worksheets("Calendar")
wsCalendar.Cells.ClearComments 'Clear Comments

With Worksheets("Alan")

For column = 4 To 34 ' collumn loop counter in calendar sheet

For row = 7 To 29 ' row loop counter in calendar sheet

If IsDate(wsCalendar.Cells(row, column)) Then

finalrow = .Range("A" & Rows.Count).End(xlUp).row
For DiaryLoop = 7 To finalrow

If IsDate(.Cells(DiaryLoop, 2).Value) Then

StartDate = .Cells(DiaryLoop, 2).Value
If Calendar = StartDate Then ' if calendar date mathes the date in the the diary

If Calendar = .Cells(DiaryLoop, 4).Value Then ' if the end date is the same as the start Date

startTime = Format(.Cells(DiaryLoop, 3).Value, "hh:mm")
TextAlan = "AHi-" & .Cells(DiaryLoop, 1).Value & " " & _
Format(.Cells(DiaryLoop, 3).Value, "hh:mm") & "-" & _
Format(.Cells(DiaryLoop, 5).Value, "hh:mm")
NewComment wsCalendar.Cells(row, column), TextAlan
Else
TextAlan = "AHi-" & .Cells(DiaryLoop, 1).Value & " " & _
Format(.Cells(DiaryLoop, 3).Value, "hh:mm") & "-" & _
.Cells(DiaryLoop, 4).Value & " " & _
Format(.Cells(DiaryLoop, 5).Value, "hh:mm")
NewComment wsCalendar.Cells(row, column), TextAlan
End If
Else
If IsDate(.Cells(DiaryLoop, 4).Value) Then

EndDate = .Cells(DiaryLoop, 4).Value
If CDate(Calendar) > CDate(StartDate) And CDate(Calendar) <= CDate(EndDate) Then

startTime = Format(.Cells(DiaryLoop, 3).Value, "hh:mm")

TextAlan = "AHi-" & .Cells(DiaryLoop, 1).Value & " - " & _
StartDate & " " & _
Format(.Cells(DiaryLoop, 3).Value, "hh:mm") & "-" & _
.Cells(DiaryLoop, 4).Value & " " & Format(.Cells(DiaryLoop, 5).Value, "hh:mm")
NewComment wsCalendar.Cells(row, column), TextAlan
End If 'CDate(Calendar) > ...
End If 'IsDate(...
End If 'Calendar = StartDate

End If 'IsDate(...
Next DiaryLoop
End If 'IsDate(wsCalendar.Cells(row, column))
Next row
Next column
End With
End Sub

Private Function NewComment(ByRef cell As Range, ByVal Text As String)

With cell

If Not .Comment Is Nothing Then

.Comment.Delete
Text = .Comment.Text & Chr(10) & Text
End If

.AddComment Text
.Comment.Visible = False
.Comment.Shape.Width = 300
.Comment.Shape.Height = 200
End With
End Function

[snb]

Use an array for sheets("Calendar").range("D7:AH29"):


sn=sheets("Calendar").range("D7:AH29")

for j=1 to ubound(sn)
for jj=1 to ubound(sn,2)
msgbox sn(j,jj)
next
next

[Jan Karel Pieterse]

To have error handling work properly, each error handler needs to have a resume XXX statement (Resume SomeLabelYouDefined, Resume or Resume Next). Otherwise subsequent errors will be ignored since VBA still is in "error handling state".
snb is right: best to test for errors rather than letting an error handler catch them.

[GTO]

...snb is right: best to test for errors rather than letting an error handler catch them.

Greetings Jan Karel,

Uhm... did you mean xld, or am I more tired than I thought?

Mark

[samuelimtech]

think im going to have to go for the array code, but kinda wanted to avoid doing it that way
thanks anyway

[Jan Karel Pieterse]

Uhm... did you mean xld

Of course I did, wasn't that obvious? :-)