Forum Discussion
Help understanding this code
Hi Kamu,
Here are some explanations
InStr(varCheckNumber, C_SEPARATOR) > 0
This function finds the position of the first occurance of "." in the string. If you function referred to A1 (IsItem(A1)), and A1 had abc.123, the InsStr(varCheckNumber, C_SEPARATOR) would retun 4. Since 4 is more than 0, the result of the function would be TRUE
-lngColumns + 1
The "-" in the offset funciton will shift the active cell reference to the left. Essentially, the formula in the line retrieves a value in the first column of the range "myCheckList" on the same row as active cell
For lngRowCount = 1 To UBound(varData)
The code starts a loop from first row of the range "MyChecklist" (which was ,techincally speaking, put into the array varData), and continues looping intil the last row of the array is reached (UBound is the function to find the last row number)
If IsItem(varData(lngRowCount, 1)) Then
The line evaluates if the first column of the current row contains a text separated by "." (as described above)
If varTopic = Left$(varData(lngRowCount, 1), InStr(varData(lngRowCount, 1), C_SEPARATOR) - 1) Then
This line finds the first characters of the text in the first column, preceeding "." (eg. it will return abc if the text was abc.123) and ocmpares then with the value in the first column of the same row in the range "MyChecklist".
At the same time, I cannot see in this code how this line would ever evaluate to TRUE, so that the Status can be updated further on, because the isntances where it can be TRUE are exceluded by the preceeding 'If IsItem' line. Are you able to send me an example table, and how the macro is used on it?
Hope this helps
Yury
Thanks, thanks a lot!
With this help I can advance now and read more codes!
I put attached the excell with this code
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = Range("myCheckList").Column + Range("myCheckList").Columns.Count - 1 ThenOne las question in this line the range Target is the range of columns in "mychecklist" plus the number of columns in this same range - 1. But I don't understand why...
Thanks again
Without opening the worksheet, I see that code as checking whether Target.Column corresponds to the LAST column in your range.
If you have n columns starting at m, then your last column is at (m+n-1).
If you don't subtract one, you would be at the first column AFTER your range.
Hope this helps.
Regards
Will any one please be able to help as I added another section in the checklist attached earlier; the status doesn't update when double clicking and also doesn't update the completion rate.
It looks like the the worksheet range is not extendable.
I have copied the full vba code below:
Option Explicit
' Public Constants
Public Const C_DONE = "R" ' Checked box Wingdings2
Public Const C_OPEN = "£" ' Empty box Wingdings2
Public Const C_MIXED = "©" ' Square in box (mixed status) Wingdings2
Public Const C_SEPARATOR = "." ' Separator between topic no and item no
Function IsTopic(varCheckNumber As Variant) As Boolean
' Number of the checkitem / topic contains no separator, i.e. the user double clicked on a topic
IsTopic = (InStr(varCheckNumber, C_SEPARATOR) = 0) And (varCheckNumber <> vbNullString)
End Function
Function IsItem(ByVal varCheckNumber As Variant) As Boolean
' Number of the checkitem / topic contains a separator, i.e. the user double clicked on a check item
IsItem = (InStr(varCheckNumber, C_SEPARATOR) > 0) And (varCheckNumber <> vbNullString)
End Function
Sub ChangeTopicStatus()
' Called after user double clicked on the status of a topic
' Set all items of this topic to the status of the topic
Dim varData As Variant
Dim varTopic As Variant
Dim strStatus As String
Dim lngRowCount As Long
Dim lngColumns As Long
On Error Resume Next
' Initialize
lngColumns = Range("myCheckList").Columns.Count
varData = Range("myCheckList")
varTopic = ActiveCell.Offset(0, -lngColumns + 1).Value
strStatus = ActiveCell.Value
' Loop through the entire check list
For lngRowCount = 1 To UBound(varData)
If IsItem(varData(lngRowCount, 1)) Then
If varTopic = Left$(varData(lngRowCount, 1), InStr(varData(lngRowCount, 1), C_SEPARATOR) - 1) Then
' Current item belongs to the selected topic, i.e. the item receives the status of the topic
varData(lngRowCount, lngColumns) = strStatus
End If
End If
Next lngRowCount
' Write the array back to the range
Range("myCheckList") = varData
' Clean up
Set varData = Nothing
Set varTopic = Nothing
End Sub
Sub AutomaticSetTopicStatus()
' Called after the status of an item was changed
' Checks how many items of this topics are already checked:
' 1. all items checked: topic status is set to done
' 2. no item is checked: topic status ist set to open
' 3. otherwise topic status is set to mixed
Dim varData As Variant
Dim varTopic As Variant
Dim lngRowCount As Long
Dim lngColumns As Long
Dim lngTopicRow As Long
Dim lngItems As Long
Dim lngCheckedItems As Long
On Error Resume Next
' Initialize
lngColumns = Range("myCheckList").Columns.Count
varData = Range("myCheckList")
varTopic = Left$(ActiveCell.Offset(0, -lngColumns + 1).Value, InStr(ActiveCell.Offset(0, -lngColumns + 1).Value, C_SEPARATOR) - 1)
' Loop through the entire check list, find the position of the topic,
' detect the number of items of this topic and the number of checked items
For lngRowCount = 1 To UBound(varData)
If varTopic = CStr(varData(lngRowCount, 1)) Then
lngTopicRow = lngRowCount
Else
If IsItem(varData(lngRowCount, 1)) Then
If varTopic = Left$(varData(lngRowCount, 1), InStr(varData(lngRowCount, 1), C_SEPARATOR) - 1) Then
lngItems = lngItems + 1
If varData(lngRowCount, lngColumns) = C_DONE Then lngCheckedItems = lngCheckedItems + 1
End If
End If
End If
Next lngRowCount
' Set the overall status of the topic
If lngCheckedItems = 0 Then
varData(lngTopicRow, lngColumns) = C_OPEN
ElseIf lngCheckedItems = lngItems Then
varData(lngTopicRow, lngColumns) = C_DONE
Else
varData(lngTopicRow, lngColumns) = C_MIXED
End If
' Write array back to the range
Range("myCheckList") = varData
' Clean up
Set varData = Nothing
Set varTopic = Nothing
End Sub
Sub ExpandCollapseItems()
Dim rngCheckList As Range
Dim varTopic As Variant
Dim lngRowCount As Long
On Error Resume Next
' Initialize
Application.ScreenUpdating = False
Set rngCheckList = Range("myCheckList")
varTopic = ActiveCell.Offset(0, -(ActiveCell.Column - rngCheckList.Column)).Value
' Loop through the entire check list and hide the rows belonging to the double clicked topic
For lngRowCount = 1 To rngCheckList.Rows.Count
If IsItem(rngCheckList(lngRowCount, 1)) Then
If (varTopic = Left$(rngCheckList(lngRowCount, 1).Value, InStr(rngCheckList(lngRowCount, 1).Value, C_SEPARATOR) - 1)) Then _
rngCheckList.Cells(lngRowCount, 1).EntireRow.Hidden = Not rngCheckList.Cells(lngRowCount, 1).EntireRow.Hidden
End If
Next lngRowCount
' Clean up
Set varTopic = Nothing
Application.ScreenUpdating = True
End Sub
Public Function CompletionRate(rngCheckList As Range) As Double
' User defined function: calculate the actual completion rate = number of checked items / number of items
Dim lngRowCount As Long
Dim lngCheckedItems As Long
Dim lngItems As Long
Dim lngColumns As Long
On Error Resume Next
' Initialize
lngColumns = rngCheckList.Columns.Count
For lngRowCount = 1 To rngCheckList.Rows.Count
If IsItem(rngCheckList(lngRowCount, 1)) Then
lngItems = lngItems + 1
If rngCheckList(lngRowCount, lngColumns) = C_DONE Then
' Item is checked
lngCheckedItems = lngCheckedItems + 1
End If
End If
Next lngRowCount
CompletionRate = lngCheckedItems / lngItems
End Function
