Is it possible to fix or declare the cell type in VBA?

I know that in VBA we can do

Cells(4, 2).Value = 100      'the cell is an integer
Cells(4, 2).Value = True     'the cell is Boolean
Cells(4, 2).Value = "abc"    'the cell is Text


Is it possible to fix or declare the cell type, for example, let Cells(4,2)

it only accept Boolean, so assignment Integer

or Text

to Cells(4, 2)

gives an error?


source to share

3 answers

[EDIT . This solution can be implemented with VBA, but it cannot be used from VBA, i.e. can still set cell value from VBA (although not manually in Excel sheet). Not sure what the OP wants. ]

Use data validation.

You can do it via VBA:

Range("A1").Validation.Add Type:=xlValidateList, Formula1:="TRUE,FALSE"


or manually: (In Excel 2003: Data> Validation ...)

enter image description here

Now you can only enter booleans TRUE


in cell A1. If you try to enter something else like. number:

enter image description here

Using data validation, you can also restrict a cell to only accept numbers, only integers, text of a certain length, basically anything. For example, to take only the text, not the numbers, you should use the Allow: the Custom, the Formula: =NOT(ISNUMBER(A1))




If you really want the cell type to be specified, you cannot. All cells in VBA contain data variants as far as I know.

If you mean the variant data type, then of course you can do it one way or another. Here's a suggestion, it's a little quick and dirty, but it works. You will need to put it in your worksheet code module. Note that it does not check if your range is bool, range is int, no matter what overlaps can cause some problems if they do.

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo handler

    Dim cell As Range, _
        boolRng As Range, _
        intRng As Range

    Set boolRng = Union(Sheet1.Range("A1:B2"), Sheet1.Range("E:E"))
    Set intRng = Union(Sheet1.Range("B7:K12"), Sheet1.Range("M:M"))

    If Not Intersect(Target, boolRng) Is Nothing Then
        For Each cell In Intersect(Target, boolRng)
            If cell.Value <> "" Then
                cell.Value = CBool(cell.Value)
            End If
        Next cell
    End If

    If Not Intersect(Target, intRng) Is Nothing Then
        For Each cell In Intersect(Target, intRng)
            If cell.Value <> "" Then
                cell.Value = CInt(cell.Value)
            End If
        Next cell
    End If

    Exit Sub

    Select Case Err.Number
        Case 13 'Type mismatch, raised when cint/cbool/c*** fails
            cell.Value = ""
            Resume Next
        Case Else
            Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End Select

End Sub


Edit: I note that you want to raise an error if the value is not assigned correctly, you can do so in the error handling section. Instead

Cell.value = ""
Resume Next


you can use

Err.Raise ISuggestAnEnumForErrorNumbers, "Sheet1.Worksheet_Change(Event)", "Attempted to assign wrong type to cell."




JFC's second proposal for using data validation.

To test it, put this code in a module ( TRIED AND TESTED )

Sub Sample()
    With Sheets("Sheet1").Range("A1")
        .Validation.Add Type:=xlValidateList, Formula1:="TRUE,FALSE"
        .Value = "SID"
    End With
End Sub


and this is in the corresponding sheet

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Application.EnableEvents = False

        On Error Resume Next
        If Not Target.SpecialCells(xlCellTypeSameValidation).Cells.Count < 1 Then
            Dim currentValidation As Excel.Validation
            Set currentValidation = Target.Validation

            If currentValidation.Type = xlValidateList Then
                '~~> I am using INSTR. If you want you can split it using "," as delim 
                '~~> and check for the value.
                If Not InStr(1, currentValidation.Formula1, Target.Value, vbTextCompare) Then
                    MsgBox "Incorrect Value"
                End If
            End If
        End If
        On Error GoTo 0
    End If
    Application.EnableEvents = True
    Exit Sub
    MsgBox Err.Description
    Resume LetsContinue
End Sub


Now try running Sub Sample()

in a module.



All Articles