Excel VBA - Set values of Enumerated elements

cheezsteak Source

In a Class Module there is

Private Enum colType
    ID = "A"
    SSN = "B"
    lName = "H"
    fName = "G"
End Enum

as a private member. Whenever the class initializes I get the Compile Error: Type Mismatch message. If I declare colType as Private Enum coltype As String. That gets highlighted red as an error and I get the Compile Error: Expected end of statement message.

Is specifying the values of enumerated elements Unallowed in excel VBA?

vbaexcel-vbaenumsexcel

Answers

answered 5 years ago ex-man #1

As written in the comments, this is not possible. There is possible workaround though that I used in the past. Have:

Private Enum colType
  ID = 1
  SSN = 2
  lName = 3
  fName = 4
End Enum

And then create a separate String property of function such as:

Public Property Get colType_String(colType) as String
  Dim v as Variant
  v= Array("A","B", ...)
  colType_String = vba.cstr(v(colType))
End Property

This is not the most universal solution, but it is easy to implement and it does the job... If you have this in the class module already you can even use property on private colType variable and there is no need to have colType input into the property.

answered 4 years ago Rich Harding #2

I quite like ex-man's solution in certain circumstances, for which reason I've upvoted it. The solution more often posited goes along the following lines:

Enum myEnum
  myName1 = 1
  myName2 = 2
  myName3 = 3
End Enum

Function getEnumName(eValue As myEnum)
  Select Case eValue
  Case 1
    getEnumName = "myName1"
  Case 2
    getEnumName = "myName2"
  Case 3
    getEnumName = "myName3"
  End Select
End Function

Debug.Print getEnumName(2) prints "myName2"

answered 4 years ago Stuart Emmett #3

I have been searching for a very long time for the answer to this question. I do not want to have to relist the contents of an Enum in either a Case statement or an array. I couldn't find the answer, but I have managed to do after finding the code somewhere to change Module content. An alteration of that has produced the following working code, to be placed in Module1:

    Option Explicit

    Enum MensNames
        Fred
        Trev = 5
        Steve
        Bill = 27
        Colin
        Andy
    End Enum

    Sub EnumStringTest()
        MsgBox EnumString(Steve) & " = " & Steve
    End Sub

    Function EnumString(EnumElement As MensNames) As String
        Dim iLineNo As Integer
        Dim iElementNo As Integer

        iElementNo = 0
        EnumString = vbNullString
        With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
            ' Find the Enum Start
            For iLineNo = 1 To .CountOfLines
                If InStr(.Lines(iLineNo, 1), "Enum MensNames") > 0 Then
                    Exit For
                End If
            Next iLineNo

            ' Find the required Element
            iLineNo = iLineNo + 1
            Do While InStr(.Lines(iLineNo, 1), "End Enum") = 0 And .Lines(iLineNo, 1) <> ""
                If InStr(2, .Lines(iLineNo, 1), "=") > 0 Then
                    iElementNo = CLng(Mid(.Lines(iLineNo, 1), InStr(2, .Lines(iLineNo, 1), "=") + 1))
                End If
                If iElementNo = EnumElement Then
                    EnumString = Left(Trim(.Lines(iLineNo, 1)), IIf(InStr(1, Trim(.Lines(iLineNo, 1)), " ") = 0, 1000, InStr(1, Trim(.Lines(iLineNo, 1)), " ") - 1))
                    Exit Do
                End If
                iElementNo = iElementNo + 1
                iLineNo = iLineNo + 1
            Loop
        End With
    End Function

answered 2 years ago sir KitKat #4

To improve the solution of Rich Harding, I use the enum to improve on readability and make it less prone to mistakes:

Enum myEnum
    myName
    someOtherName
    lastName
End Enum

Function getEnumName(eValue As myEnum) As String
    Select Case eValue
        Case myName:        getEnumName = "myName"
        Case someOtherName: getEnumName = "someOtherName"
        Case lastName:      getEnumName = "lastName"
    End Select
End Function

answered 2 years ago Will #5

The long integers in the Enum could be Base-10 encodings. The ToAlpha function below converts the number to Base-26, represented with uppercase alphabet characters. To get the number, call the ToLong function with a string.

This would work up to 6 characters (anything above 2,147,483,647 overflows the Enum value).

Private Enum colType
  ID = 0 'A
  SSN = 1 'B
  lName = 7 'H
  fName = 6 'G
  WORD = 414859
  FXSHRXX = 2147483647 'Maximum long
End Enum

Sub test()
  Debug.Print "ID: " & ToAlpha(colType.ID)
  Debug.Print "SSN: " & ToAlpha(colType.SSN)
  Debug.Print "lName: " & ToAlpha(colType.lName)
  Debug.Print "fName: " & ToAlpha(colType.fName)
  Debug.Print "WORD: " & ToAlpha(colType.WORD)
  Debug.Print "FXHRXX: " & ToAlpha(colType.FXSHRXX)
End Sub

Function ToAlpha(ByVal n)
  If n < 0 Or Int(n) <> n Then Exit Function 'whole numbers only
  Do While n > 25
      ToAlpha = Chr(n Mod 26 + 65) & ToAlpha
      n = n \ 26 - 1 'base 26
  Loop
  ToAlpha = Chr(n + 65) & ToAlpha
End Function

Function ToLong(ByVal s)
  s = UCase(s)
  Dim iC
  For i = 1 To Len(s)
    iC = Asc(Mid(s, i, 1))
    If iC < 65 Or iC > 90 Then 'A-Z only
      ToLong = -1
      Exit Function
    End If
    ToLong = ToLong * 26 + (iC - 64) 'base 26
  Next
  ToLong = ToLong - 1
End Function

answered 7 months ago Fahad Al-Dossary #6

I hope this help

Reference: (Microsoft Visual Basic for Application Extensibility 5.3) is required

Public Enum SecurityLevel
    IllegalEntry = 0
    SecurityLevel1 = 1
    SecurityLevel2 = 3
    SecurityLevel3
    SecurityLevel4 = 10
End Enum
Public Sub Test1()
    Cells.Clear
    Range("A1").Value = StrEnumVal("SecurityLevel", SecurityLevel.IllegalEntry)
    Range("A2").Value = StrEnumVal("SecurityLevel", SecurityLevel.SecurityLevel1)
    Range("A3").Value = StrEnumVal("SecurityLevel", SecurityLevel.SecurityLevel2)
    Range("A4").Value = StrEnumVal("SecurityLevel", SecurityLevel.SecurityLevel3)
    Range("A5").Value = StrEnumVal("SecurityLevel", SecurityLevel.SecurityLevel4)
End Sub
Public Sub AaaTest2()
    Cells.Clear
    Dim E As Long
    For E = SecurityLevel.IllegalEntry To SecurityLevel.SecurityLevel4
    Cells(E + 1, 1) = StrEnumVal("SecurityLevel", E)
    Next
End Sub
Function StrEnumVal(BEnumName As String, EnumItm As Long) As String
    '''''''''''''''''''''''''
    ' Fahad Mubark ALDOSSARY'
    '''''''''''''''''''''''''
        Dim vbcomp As VBComponent
        Dim modules As Collection
        Dim CodeMod As VBIDE.CodeModule
        Dim numLines As Long ' end line
        Dim MdlNm As String
        Dim lineNum As Long
        Dim thisLine As String, SpltEnm As String, EnumITems As String, Itm As String
        Dim EEnumName As String
        Dim Indx As Long
        Dim I As Long, s As Long
        Dim SpltEI As Variant
        Indx = 0
        Set modules = New Collection
        BEnumName = "Enum " & BEnumName
        EEnumName = "End Enum"
        For Each vbcomp In ThisWorkbook.VBProject.VBComponents

            'if normal or class module
            If vbcomp.Type = vbext_ct_StdModule Then
            Set CodeMod = vbcomp.CodeModule
                With CodeMod
                    numLines = .CountOfLines
                        For lineNum = 1 To numLines
                            thisLine = .Lines(lineNum, 1)

                                If InStr(1, thisLine, BEnumName, vbTextCompare) > 0 Then

                                    If InStr(thisLine, ":") > 0 Then
                                   ' thisLine = Replace(thisLine, BEnumName & ":", "") ' Remove Enum Titel Enum
                                    thisLine = Right(thisLine, Len(thisLine) - InStr(1, thisLine, ":"))
                                        For s = 0 To UBound(Split(thisLine, ":"))
                                            SpltEnm = Split(thisLine, ":")(s)
                                            If InStr(SpltEnm, " = ") > 0 Then
                                            Itm = SpltEnm
                                            Indx = CDbl(Split(SpltEnm, " = ")(1))
                                            Else
                                            Itm = SpltEnm & " = " & Indx
                                            End If
                                            EnumITems = EnumITems & IIf(EnumITems <> "", vbNewLine, "") & Itm    '''''
                                            Indx = Indx + 1
                                        Next
                                        If InStr(1, thisLine, EEnumName, vbTextCompare) > 0 Then
                                         EnumITems = Replace(EnumITems, "End Enum", "")
                                        Exit For
                                        End If
                                    Else
                                    'Only Title show if nothing bedside
                                    End If
                                ElseIf InStr(1, thisLine, EEnumName, vbTextCompare) > 0 Then
                                    If InStr(thisLine, ":") > 0 Then
                                        For s = 0 To UBound(Split(thisLine, ":"))
                                            SpltEnm = Split(thisLine, ":")(s)
                                            If InStr(SpltEnm, " = ") > 0 Then
                                            Itm = SpltEnm
                                            Indx = CDbl(Split(SpltEnm, " = ")(1))
                                            Else
                                            Itm = SpltEnm & " = " & Indx
                                            End If
                                            EnumITems = EnumITems & IIf(EnumITems <> "", vbNewLine, "") & Itm    '''''
                                            EnumITems = Replace(EnumITems, "End Enum", "")

                                            Indx = Indx + 1
                                        Next
                                    Else
                                    End If
                                Exit For
                                Else

                                    If InStr(thisLine, ":") > 0 Then
                                        For s = 0 To UBound(Split(thisLine, ":"))
                                            SpltEnm = Split(thisLine, ":")(s)

                                            If InStr(SpltEnm, " = ") > 0 Then
                                            Itm = SpltEnm
                                            Indx = CDbl(Split(SpltEnm, " = ")(1))
                                            Else
                                            Itm = SpltEnm & " = " & Indx
                                            End If
                                        EnumITems = EnumITems & IIf(EnumITems <> "", vbNewLine, "") & Itm    '''''
                                        Indx = Indx + 1
                                        Next
                                    Else

                                        If InStr(thisLine, " = ") > 0 Then
                                        Itm = thisLine
                                        Indx = Split(thisLine, " = ")(1)
                                        Else
                                        Itm = thisLine & " = " & Indx
                                        End If
                                        EnumITems = EnumITems & IIf(EnumITems <> "", vbNewLine, "") & Itm '''''
                                    End If
                                    Indx = Indx + 1
                                End If

                        Next lineNum
                    If InStr(1, thisLine, EEnumName, vbTextCompare) > 0 Then Exit For
                End With 'CodeMod
            End If
        Next vbcomp

        SpltEI = Split(EnumITems, vbNewLine)
        For I = LBound(SpltEI) To UBound(SpltEI)
             If CDbl(Replace(Split(SpltEI(I), " = ")(1), " ", "")) = EnumItm Then
             StrEnumVal = Replace(Split(SpltEI(I), " = ")(0), " ", "")
             Exit For
             Else
             End If
        Next

End Function

To active Required Reference copy Below Code then delete it

enter image description here

Sub AddReferenceVBA()
        AddRef ThisWorkbook, "{0002E157-0000-0000-C000-000000000046}", "VBIDE", 5, 3
End Sub

Sub AddRef(wbk As Workbook, sGuid As String, sRefName As String, sRefMajor As Long, sRefMinor As Long)
        Dim I As Integer
        On Error GoTo EH
        With wbk.VBProject.References
            For I = 1 To .Count
                If .Item(I).Name = sRefName Then

                   Exit For
                End If
            Next I
            If I > .Count Then

               .AddFromGuid sGuid, sRefMajor, sRefMinor ' 0,0 should pick the latest version installed on the computer
                ThisWorkbook.Save
            End If
        End With
EX:    Exit Sub
EH:         MsgBox "Error in 'AddRef'" & vbCrLf & vbCrLf & Err.Description
        Resume EX
        Resume ' debug code
End Sub

answered 7 months ago Fahad Al-Dossary #7

Updated and corrcted

        Public Enum SecurityLevelp
        IllegalEntry = 1
        SecurityLVL1
        SecurityLVL2 = 8
        SecurityLVL3
        SecurityLVL4 = 10
        SecurityLVL5
        SecurityLVL6 = 15

        End Enum

    Public Sub Test()
        AddRef ThisWorkbook, "{0002E157-0000-0000-C000-000000000046}", "VBIDE", 5, 3 'if need or delete this line. To select required Reference
        MsgBox GeEnumValues("SecurityLevelp", 1) 'to replace enum
        MsgBox GeEnumValues("SecurityLevelp", SecurityLVL3) 'to replace enum
        MsgBox GeEnumValues("SecurityLevelp", 11) 'to replace enum
        MsgBox GeEnumValues("SecurityLevelp", SecurityLVL6) 'to replace enum
        End Sub

    Function GeEnumValues(PrcName As String, EnumItm As Long)
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'Reference:Microsoft Visual Basic for Extensibility 5.3 is required'
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim ProcStrLn As Long, ProcAcStrLn As Long, ProcCntLn As Long, N As Long, D As Long, S As Long, PrcCnountLine As Long
        Dim DecStrLn As Long, DecEndLn As Long
        Dim ThisLine As String, Dec As String, ThisSub As String, Itm As String
        Dim DecItm As Variant
            Set VBProj = ThisWorkbook.VBProject
            For Each VBComp In VBProj.VBComponents
                With VBComp
                    If .Type = vbext_ct_StdModule Then ' Withen Standr Module
                        With .CodeModule
                            If InStr(1, .Lines(1, .CountOfLines), PrcName) > 0 Then 'Replace Sub Function
                                On Error Resume Next
                                ProcStrLn = .ProcStartLine(PrcName, vbext_pk_Proc) ' Procedure Start Line
                                ProcAcStrLn = .ProcBodyLine(PrcName, vbext_pk_Proc) ' Actually Procedure Start Line
                                ProcCntLn = .ProcCountLines(PrcName, vbext_pk_Proc)
                                PrcCnountLine = ProcCntLn - (ProcAcStrLn - ProcStrLn)
                                If ProcAcStrLn > 0 Then
                                    'If PrcName = .ProcOfLine(ProcAcStrLn, vbext_pk_Proc) Then 'Get Proce Name
                                       ' For N = (ProcAcStrLn + 1) To (ProcAcStrLn + PrcCnountLine - 1) ' Add 1 to avoid chane Procedure Name and -1 to avoid replace Next Procedure
                                           ' ThisLine = .Lines(N, 1)
                                           ' If InStr(N, ThisLine, Fnd, vbTextCompare) > 0 Then
                                            'ThisSub = ThisSub & vbNewLine & ThisLine
                                            'End If
                                        'Next
                                   ' End If
                                Else '____________________________________________________________________________________________________
                                ' Replce Declaration such as Enum
                                For D = 1 To .CountOfDeclarationLines
                                        ThisLine = .Lines(D, 1)
                                        If InStr(1, ThisLine, "Enum " & PrcName) > 0 Then
                                        Titl = DecItm(D)
                                            Dec = Dec & vbNewLine & ThisLine: DecStrLn = D
                                             S = InStr(1, ThisLine, "Enum " & PrcName) + Len("Enum " & PrcName) 'Start replace column
                                        ElseIf InStr(1, Dec, "Enum " & PrcName) > 0 And InStr(1, ThisLine, "End Enum") > 0 Then
                                            Dec = Dec & vbNewLine & ThisLine: DecEndLn = D
                                            Exit For
                                        ElseIf InStr(1, Dec, "Enum " & PrcName) Then
                                            Dec = Dec & vbNewLine & ThisLine
                                        End If
                                Next 'Declaration
                                ' MsgBox .Lines(DecStrLn, DecEndLn - DecStrLn + 1) '=MsgBox Dec 'Declaration
                                End If '_______________________________________________________________________________________________________
                                On Error GoTo 0
                            End If
                        End With ' .CodeModule
                    End If ' .Type
                End With ' VBComp
            Next ' In VBProj.VBComponents
               'Declaration
               DecItm = Split(Dec, vbNewLine)
              For D = LBound(DecItm) To UBound(DecItm)

              Itm = DecItm(D)
              If Itm <> "" And InStr(1, Itm, "Enum " & PrcName, vbTextCompare) = 0 And InStr(1, Itm, "End Enum") = 0 Then
                If InStr(1, Itm, " = ", vbTextCompare) > 0 Then
                    N = Split(Itm, " = ")(1)
                Else
                    Itm = Itm & " = " & N
                End If
                If EnumItm = N Then
                  GeEnumValues = Trim(Split(Itm, " = ")(0))
                  Exit Function
                End If
                N = N + 1
              End If
              Next

        End Function

    ' if needed o delte below code
    Sub AddRef(wbk As Workbook, sGuid As String, sRefName As String, sRefMajor As Long, sRefMinor As Long)
            Dim i As Integer
            On Error GoTo EH
            With wbk.VBProject.References
                For i = 1 To .Count
                    If .Item(i).Name = sRefName Then
                       Exit For
                    End If
                Next i
                If i > .Count Then

                   .AddFromGuid sGuid, sRefMajor, sRefMinor ' 0,0 should pick the latest version installed on the computer
                End If
            End With
            EX:             Exit Sub
            EH:             MsgBox "Error in 'AddRef'" & vbCrLf & vbCrLf & Err.Description
            Resume EX
            Resume ' debug code
            ThisWorkbook.Save
        End Sub

comments powered by Disqus