VBA Code Issue on Mac Platform (working perfectly on Windows)

[Saher Naji]

Hi there,

What could be causing the VBA code to malfunction on Mac?

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, cell As Range
    Dim lastRow As Long, lastID As String
    Dim initialPrefix As String, newRowDetected As Boolean
    Dim existingIDs As Object
    Dim existingCell As Range

    On Error GoTo ErrorHandler

    ' Define range of column B, excluding header
    Set rng = Me.Range("B2:B" & Me.Cells(Me.Rows.Count, "B").End(xlUp).Row)

    ' Check if change occurred in range
    If Not Intersect(Target, rng) Is Nothing Then
        Application.EnableEvents = False

        ' Check for new row insertion
        newRowDetected = False
        For Each cell In Intersect(Target, rng)
            If cell.Row > lastRow Then
                newRowDetected = True
                Exit For
            End If
        Next cell

        ' Handle existing data changes
        If Not newRowDetected Then
            For Each cell In Intersect(Target, rng)
                ' Check if corresponding cell in column A is empty
                If Me.Cells(cell.Row, "A").Value = "" Then

                    ' Create new dictionary for each cell
                    Set existingIDs = CreateObject("Scripting.Dictionary")

                    ' Initialize dictionary with existing IDs
                    For Each existingCell In Me.Range("A2:A" & Me.Cells(Me.Rows.Count, "A").End(xlUp).Row)
                        If Not IsEmpty(existingCell.Value) Then existingIDs.Add existingCell.Value, True
                    Next existingCell

                    ' Find highest existing ID
                    lastID = ""
                    For Each Key In existingIDs.Keys
                        If Val(Right(Key, 4)) > Val(Right(lastID, 4)) Then lastID = Key
                    Next Key

                    ' Check if duplicate ID exists
                    If Not existingIDs.Exists(lastID) Then
                        ' Extract initial prefix from first ID or set default
                        If Not IsEmpty(lastID) Then
                            initialPrefix = Left(lastID, 3)
                        Else
                            initialPrefix = "ID"
                        End If

                        ' Increment and update unique ID
                        Me.Cells(cell.Row, "A").Value = initialPrefix & Format(Val(Right(lastID, 4)) + 1, "00000")

                        ' Update dictionary with new ID
                        existingIDs.Add Me.Cells(cell.Row, "A").Value, True
                    Else
                        ' Handle duplicate ID case (e.g., show message or skip update)
                        Debug.Print "Duplicate ID found: " & lastID
                    End If
                End If
            Next cell
        End If

        ' Handle new row insertion
        If newRowDetected Then
            lastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
            For i = 2 To lastRow
                If Me.Cells(i, "A").Value = "" Then

                    ' Create new dictionary for each iteration
                    Set existingIDs = CreateObject("Scripting.Dictionary")

                    ' Initialize dictionary with existing IDs
                    For Each existingCell In Me.Range("A2:A" & Me.Cells(Me.Rows.Count, "A").End(xlUp).Row)
                        If Not IsEmpty(existingCell.Value) Then existingIDs.Add existingCell.Value, True
                    Next existingCell

                    ' Find highest existing ID
                    lastID = ""
                    For Each Key In existingIDs.Keys
                        If Val(Right(Key, 4)) > Val(Right(lastID, 4)) Then lastID = Key
                    Next Key

                    ' Extract initial prefix from first ID or set default
                    If Not IsEmpty(lastID) Then
                        initialPrefix = Left(lastID, 3)
                    Else
                        initialPrefix = "ID"
                    End If

                    ' Increment and update unique ID
                    Me.Cells(i, "A").Value = initialPrefix & Format(Val(Right(lastID, 4)) + 1, "00000")

                    ' Update dictionary with new ID
                    existingIDs.Add Me.Cells(i, "A").Value, True
                End If
            Next i
        End If

        Application.EnableEvents = True
    End If

    Exit Sub

ErrorHandler:
    Debug.Print "Error: " & Err.Number & " - " & Err.Description
    Application.EnableEvents = True
End Sub

THANK YOU

 

[RoryA]

You can't use the Scripting runtime library on a Mac as it doesn't exist. There is a replacement Dictionary class available here: GitHub - VBA-tools/VBA-Dictionary: Drop-in replacement for Scripting.Dictionary on Mac or you could use a Collection instead.

 

[Saher Naji]

You can't use the Scripting runtime library on a Mac as it doesn't exist. There is a replacement Dictionary class available here: GitHub - VBA-tools/VBA-Dictionary: Drop-in replacement for Scripting.Dictionary on Mac or you could use a Collection instead.

Thank you. I hope that this revised code will seamlessly function on Mac without encountering any issues

#If Mac Then
    ' Use the Dictionary replacement for Mac
    Dim existingIDs As New cVBA_Dictionary
#Else
    ' Use Scripting.Dictionary for Windows
    Dim existingIDs As Object
#End If

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, cell As Range
    Dim lastRow As Long, lastID As String
    Dim initialPrefix As String, newRowDetected As Boolean
    Dim existingCell As Range

    On Error GoTo ErrorHandler

    ' Define range of column B, excluding header
    Set rng = Me.Range("B2:B" & Me.Cells(Me.Rows.Count, "B").End(xlUp).Row)

    ' Check if change occurred in range
    If Not Intersect(Target, rng) Is Nothing Then
        Application.EnableEvents = False

        ' Check for new row insertion
        newRowDetected = False
        For Each cell In Intersect(Target, rng)
            If cell.Row > lastRow Then
                newRowDetected = True
                Exit For
            End If
        Next cell

        ' Handle existing data changes
        If Not newRowDetected Then
            For Each cell In Intersect(Target, rng)
                ' Check if corresponding cell in column A is empty
                If Me.Cells(cell.Row, "A").Value = "" Then
                    ' Initialize dictionary with existing IDs
                    #If Not Mac Then
                        Set existingIDs = CreateObject("Scripting.Dictionary")
                    #End If

                    existingIDs.RemoveAll
                    For Each existingCell In Me.Range("A2:A" & Me.Cells(Me.Rows.Count, "A").End(xlUp).Row)
                        If Not IsEmpty(existingCell.Value) Then existingIDs.Add existingCell.Value, True
                    Next existingCell

                    ' Find highest existing ID
                    lastID = ""
                    For Each Key In existingIDs.Keys
                        If Val(Right(Key, 4)) > Val(Right(lastID, 4)) Then lastID = Key
                    Next Key

                    ' Check if duplicate ID exists
                    If Not existingIDs.Exists(lastID) Then
                        ' Extract initial prefix from first ID or set default
                        If Not IsEmpty(lastID) Then
                            initialPrefix = Left(lastID, 3)
                        Else
                            initialPrefix = "ID"
                        End If

                        ' Increment and update unique ID
                        Me.Cells(cell.Row, "A").Value = initialPrefix & Format(Val(Right(lastID, 4)) + 1, "00000")

                        ' Update dictionary with new ID
                        existingIDs.Add Me.Cells(cell.Row, "A").Value, True
                    Else
                        ' Handle duplicate ID case (e.g., show message or skip update)
                        Debug.Print "Duplicate ID found: " & lastID
                    End If
                End If
            Next cell
        End If

        ' Handle new row insertion
        If newRowDetected Then
            lastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
            For i = 2 To lastRow
                If Me.Cells(i, "A").Value = "" Then
                    ' Initialize dictionary with existing IDs
                    #If Not Mac Then
                        Set existingIDs = CreateObject("Scripting.Dictionary")
                    #End If

                    existingIDs.RemoveAll
                    For Each existingCell In Me.Range("A2:A" & Me.Cells(Me.Rows.Count, "A").End(xlUp).Row)
                        If Not IsEmpty(existingCell.Value) Then existingIDs.Add existingCell.Value, True
                    Next existingCell

                    ' Find highest existing ID
                    lastID = ""
                    For Each Key In existingIDs.Keys
                        If Val(Right(Key, 4)) > Val(Right(lastID, 4)) Then lastID = Key
                    Next Key

                    ' Extract initial prefix from first ID or set default
                    If Not IsEmpty(lastID) Then
                        initialPrefix = Left(lastID, 3)
                    Else
                        initialPrefix = "ID"
                    End If

                    ' Increment and update unique ID
                    Me.Cells(i, "A").Value = initialPrefix & Format(Val(Right(lastID, 4)) + 1, "00000")

                    ' Update dictionary with new ID
                    existingIDs.Add Me.Cells(i, "A").Value, True
                End If
            Next i
        End If

        Application.EnableEvents = True
    End If

    Exit Sub

ErrorHandler:
    Debug.Print "Error: " & Err.Number & " - " & Err.Description
    Application.EnableEvents = True
End Sub

 

[RoryA]

Since you have the class in the workbook, you might as well just use it regardless of platform.

 

[Cristian Buse]

Or, you can now use VBA-FastDictionary which is orders of magnitude faster for most scenarios.