Help understanding this code

Copper Contributor

Hi,

I'm new in VBA.  I've been reading and seeing courses on internet this last three days and triying to understand every single line in this code, but I cant read completely all.

Could someone try to explain the reason of the parts with bolt and underline please.

 

Thanks!

 

 

 

Public Const C_SEPARATOR = "."

Function IsItem(ByVal varCheckNumber As Variant) As Boolean
 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 (Why put a - before the number of colums?)
    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

 

4 Replies

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 Then

One 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