Utilizing an array within an inputBox-CodePudding

I want to create a little input box function where the user's input can only be months of the year (January, February, March etc), I figured it could be done via utilizing a variant variable (months). However, I am getting a type mismatch error , is what im trying to achieve achievable? thanks.

Sub test()

Dim NewName As Variant, Months As Variant
Months = Split("January,February,March,April,May,June,July,August,September,October,November,December")

Re_Enter_NewName:
NewName = InputBox("Please Write Month- Case Sensitive", "MONTH", vbOKCancel)

For Each Months In NewName ''Type Mismatch
If NewName = Months Then
Exit Sub

ElseIf NewName <> Months Then
 MsgBox "Please Enter a Month of the Year"
 GoTo Re_Enter_NewName:
Else
End If

Next Months

End Sub

CodePudding user response：

I would use two functions:

One function to create the array with valid months - please check the code below: you have to use array not split. Alternatively you could read the valid month names from a worksheet or create the list automatically etc.

One generic function to check if a value is within an array

Option Explicit

Sub testGetMonthsName()

Dim MonthSelected As Variant, arrMonths As Variant
arrMonths = getMonthArray

Re_Enter_NewName:
MonthSelected = InputBox("Please Write Month- Case Sensitive", "MONTH")

If MonthSelected = vbNullString Then
    'cancel or empty
    Exit Sub

ElseIf isValueInArray(MonthSelected, arrMonths) Then
    'MonthSelected is valid
    Exit Sub
    
Else
    'MonthSelected is not valid
    MsgBox "Please Enter a Month of the Year"
    GoTo Re_Enter_NewName:
End If

End Sub


Private Function getMonthArray() As Variant
getMonthArray = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
End Function

Private Function isValueInArray(value As Variant, arrValues As Variant) As Boolean
Dim i As Long
For i = LBound(arrValues) To UBound(arrValues)
    If arrValues(i) = value Then
        isValueInArray = True
        Exit For
    End If
Next
End Function

Based on comment from @ChristanBuse - a more advanced version:

Option Explicit

Sub test_getMonthFromUser()

Dim strMonth As String, cancel As Boolean

Do
    strMonth = getMonthNameFromUser(cancel)
    If cancel = True Then Exit Sub
    
    If isMonthNameValid(strMonth) = False Then
        If MsgBox("Please enter a valid month name", vbOKCancel   vbExclamation) = vbCancel Then
            Exit Do
        Else
            strMonth = vbNullString
        End If
    End If
Loop Until LenB(strMonth) > 0

If LenB(strMonth) > 0 Then
    MsgBox "Valid month selected: " & strMonth
End If

End Sub

Private Function getMonthNameFromUser(ByRef cancel As Boolean) As String

Dim strMonth As String
strMonth = InputBox("Please Write Month- Case Sensitive", "MONTH")

If StrPtr(strMonth) = 0 Then
    cancel = True
    Exit Function
End If

getMonthNameFromUser = strMonth

End Function


Private Function isMonthNameValid(strMonth As String) As Boolean
'will check according to systems language
'e.g. in German: Januar - in English: January
Dim i As Long
For i = 1 To 12
    If MonthName(i) = strMonth Then
        isMonthNameValid = True
        Exit For
    End If
Next
End Function

CodePudding user response：

You should also handle case when user cancels input box to prevent endless work

Sub test()
  Dim NewName As Variant, Months As Variant, mname, UserMonth
  UserMonth = ""
  'Months = Split("January,February,March,April,May,June,July,August,September,October,November,December")
  'Months is Variant/String array (1 element)
  'be sure to specify delimiter (comma)
  Months = Split( _
    "January,February,March,April,May,June,July,August,September,October,November,December", _
    ",")
    'Months is Variant/String array (12 elements)
Re_Enter_NewName:
  NewName = InputBox("Please Write Month- Case Sensitive", "MONTH", vbOKCancel)
  
  'For Each Months In NewName 'Type Mismatch: for each array in string
  For Each mname In Months
    If NewName = mname Then
      UserMonth = mname
    End If
  Next mname
  If UserMonth = "" Then
    MsgBox "Please Enter a Month of the Year"
     GoTo Re_Enter_NewName:
  End If
End Sub