Afternoon everyone,
I'll try and keep this short and unambiguous. I have a spreadsheet with pupils names (rows) and the subjects (columns) they are struggling in (I'm a teacher). The final column counts the number of notes for each pupil (row). I did manage to write a quick subroutine that counted the comments across that row, but when the SS became 90 rows, the SS started the lag badly (the subroutine was called from within each cell in the final column =countNotes(range). So I started rewriting the subroutine so that it uses the ActiveSheet.comments collection to populate the last column when SS opens and when user saves it. But I'm struggling and wise enough to know I need help.
Here's a visual representation of what I'm trying to do:
I need the ActiveSheet.comments collection converted into a 2D array so can populate the last column using this code:
I have made four attempts. None work. When the last item in the collection is compared to an item that doesn't exist, an error is produced. I just can't figure out the logic. I'm not an idiot, I know checking for a value that doesn't exist is going to produce an error. Maybe I need another condition that checks if the loop is at the end of the collection & array and stop it comparing? But this just seems over-complicated and inefficient.
Here are my attempts. Attempt 1:
Attempt 2:
Attempt 3:
Attempt 4:
I hope everyone realises I've tried and tried before asking for help. Any help, even if it's just in pseudocode form, would be greatly appreciated.
Thanks,
Liam
I'll try and keep this short and unambiguous. I have a spreadsheet with pupils names (rows) and the subjects (columns) they are struggling in (I'm a teacher). The final column counts the number of notes for each pupil (row). I did manage to write a quick subroutine that counted the comments across that row, but when the SS became 90 rows, the SS started the lag badly (the subroutine was called from within each cell in the final column =countNotes(range). So I started rewriting the subroutine so that it uses the ActiveSheet.comments collection to populate the last column when SS opens and when user saves it. But I'm struggling and wise enough to know I need help.
Here's a visual representation of what I'm trying to do:
Code:
' What i need to produce (reversed because I
' realised quickly that I could only redim
' last dimension)
'ActiveSheet.Comments looks like in my SS
'row # of notes arrNotes(0,0) arrNotes(0,1)
' # of notes row
'35 1 1 35
'86 1 1 86
'90 1 3 90
'90 1
'90 1
I need the ActiveSheet.comments collection converted into a 2D array so can populate the last column using this code:
Code:
'populate notes column
For i = 0 To UBound(arrNotes, 2)
Cells(arrNotes(1, i), ThisWorkbook.newLastCol(ActiveSheet)).Value = arrNotes(0, i)
Next i
I have made four attempts. None work. When the last item in the collection is compared to an item that doesn't exist, an error is produced. I just can't figure out the logic. I'm not an idiot, I know checking for a value that doesn't exist is going to produce an error. Maybe I need another condition that checks if the loop is at the end of the collection & array and stop it comparing? But this just seems over-complicated and inefficient.
Here are my attempts. Attempt 1:
Code:
Sub countNotess()
Dim i As Integer
Dim ASCs As Comments
Dim arrNotes() As Integer
'ASCs = ActiveSheet.Comments
'loop through each comment in SS
For i = 0 To ActiveSheet.Comments.Count - 1
'redim the array on first iteration
If i = 0 Then
'do this before the loop and the array will always grow even if counter increases
ReDim Preserve arrNotes(1, i)
arrNotes(0, i) = 1 'note
arrNotes(1, i) = ActiveSheet.Comments(i + 1).Parent.row 'row
Else
'check if counter has not already started for this row
If ActiveSheet.Comments(i + 1).Parent.row > arrNotes(1, i - 1) Then
ReDim Preserve arrNotes(1, i)
arrNotes(0, i) = 1 'note
arrNotes(1, i) = ActiveSheet.Comments(i + 1).Parent.row ' row
Else 'counter already started for this row so increase existing counter
arrNotes(0, i - 1) = arrNotes(0, i - 1) + 1
End If
End If
Next i
'populate notes column
For i = 0 To UBound(arrNotes, 2)
Cells(arrNotes(1, i), ThisWorkbook.newLastCol(ActiveSheet)).Value = arrNotes(0, i)
Next i
End Sub
Attempt 2:
Code:
Sub countNotesx()
Dim c As Comment
Dim i As Integer
Dim arrNotes() As Integer
'loop through each comment in SS
For i = ActiveSheet.Comments.Count - 1 To 0 Step -1
If i > 0 Then
If ActiveSheet.Comments(i + 1).Parent.row > ActiveSheet.Comments(i).Parent.row Then
ReDim Preserve arrNotes(1, i)
arrNotes(0, i) = 1 'note
arrNotes(1, i) = ActiveSheet.Comments(i + 1).Parent.row 'row
Else
arrNotes(0, i) = arrNotes(0, i) + 1
End If
Else
ReDim Preserve arrNotes(1, i)
arrNotes(0, i) = 1 'note
arrNotes(1, i) = ActiveSheet.Comments(i + 1).Parent.row 'row
End If
Next i
End Sub
Attempt 3:
Code:
Sub countNotespppp()
Dim c As Comment
Dim i As Integer
Dim arrNotes() As Integer
'loop through each comment in SS
For i = 0 To ActiveSheet.Comments.Count - 1
If i = 0 Then
ReDim Preserve arrNotes(1, i)
arrNotes(0, i) = 1 'note
arrNotes(1, i) = ActiveSheet.Comments(i + 1).Parent.row 'row
Else
If ActiveSheet.Comments(i).Parent.row < ActiveSheet.Comments(i + 1).Parent.row Then
ReDim Preserve arrNotes(1, i)
arrNotes(0, i) = 1 'note
arrNotes(1, i) = ActiveSheet.Comments(i + 1).Parent.row 'row
Else
Do While ActiveSheet.Comments(i - 1).Parent.row = ActiveSheet.Comments(i).Parent.row
arrNotes(0, i) = arrNotes(0, i) + 1 'note
i = i - 1 'ensure pointless iterations aren't made
End If
End If
Next i
End Sub
Attempt 4:
Code:
Sub countNotes()
Dim n As Comment
Dim i As Integer
Dim arrNotes() As Integer
i = 0
'loop through each comment in SS
Do While i < ActiveSheet.Comments.Count - 1
ReDim Preserve arrNotes(1, i)
arrNotes(0, i) = 1 'note
arrNotes(1, i) = ActiveSheet.Comments(i + 1).Parent.row 'row
Do While ActiveSheet.Comments(i + 1).Parent.row = ActiveSheet.Comments(i + 2).Parent.row
arrNotes(0, i) = arrNotes(0, i) + 1 'note
i = i + 1
Loop
Debug.Print arrNotes(0, i)
Debug.Print arrNotes(1, i)
i = i + 1
Loop
End Sub
I hope everyone realises I've tried and tried before asking for help. Any help, even if it's just in pseudocode form, would be greatly appreciated.
Thanks,
Liam
Last edited: