samuelimtech
06-12-2014, 12:48 AM
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
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