Solved: Determining Type of Data in a Column

[MWE]

I have several Excel applications that use a custom written sorting process. I presently use a brute force approach to determine variable type for specific fields (cols) so that data is correctly compared (comparisons can be more than just "equal"). I only care if the data is numeric, date, boolean or text. I sample the data values in the col (the total col if # rows <= 30, a random selection if the # rows > 30) and determine the type found. It is unusual for a col (excluding header info) to not be 100% of a particular type.

Anyone know a better way? I thought about examining formats and that would be good if I were consistent enough to format the entire column similarly.

Thanks

[RolfJ]

The following macro would automatically alert you to the first non-numeric cell in column you would like to check once you placed it into the VBA module associated with the particular worksheet:


Const COLUMNTOCHECK As String = "A"

Private Sub Worksheet_Activate()
Dim r As Range
Set r = ActiveSheet.UsedRange.Columns(COLUMNTOCHECK)
Dim rCell As Range
For Each rCell In r.Cells
If Not IsNumeric(rCell.Value) Then
MsgBox ("Cell " & rCell.Address & " is not numeric")
End If
Next rCell
End Sub

[MWE]

thanks for your prompt reply. Your approach assumes a universal check for numeric values each time the sheet is activated. That could be useful, but not in my application. I need to check specific cols (only) and want to know more than just numeric or not. The current method is to check for a series of types (vs just numeric) and return the type found and an additional message only if the procedure has found multiple types in the column.

[Paul_Hossler]

Something like this to get started? Not sure it'll cover all cases but might be a starting point


Option Explicit
Sub SameType()

Dim iAll As Long, iNum As Long, iStr As Long, iBlank As Long, iUsed As Long

Dim rData As Range
Set rData = Intersect(ActiveSheet.Columns(1), ActiveSheet.UsedRange)

iAll = 0
iNum = 0
iStr = 0
iBlank = 0
On Error Resume Next
With rData
iAll = .Cells.Count
iBlank = .SpecialCells(xlCellTypeBlanks).Count
iUsed = iAll - iBlank

iNum = .SpecialCells(xlCellTypeConstants, xlNumbers).Count
iNum = iNum + .SpecialCells(xlCellTypeFormulas, xlNumbers).Count
iStr = .SpecialCells(xlCellTypeConstants, xlTextValues).Count
iStr = iStr + .SpecialCells(xlCellTypeFormulas, xlTextValues).Count
End With

If (iNum = iUsed) Or (iStr = iUsed) Then
MsgBox "All the same"
Else
MsgBox "Not all the same"
End If


End Sub


Paul

[RolfJ]

Borrowing a little from Paul's suggestion this code might get you closer to your solution (you can set the columns to search in the strColumns = Array("A", "B", "C") statement):

Private Sub Worksheet_Activate()
Dim iAll As Long, iNum As Long, iStr As Long, iBlank As Long, iBoolean As Long, iUsed As Long

Dim r As Range
Set r = ActiveSheet.UsedRange
Dim strColumns() As Variant
strColumns = Array("A", "B", "C")

Dim strCol As Variant
Dim rCol As Range
Dim rCell As Range

On Error Resume Next

For Each strCol In strColumns

Set rCol = r.Columns(strCol)

With rCol
iAll = .Cells.Count
iBlank = 0
iBlank = .SpecialCells(xlCellTypeBlanks).Count
iUsed = iAll - iBlank
End With

iNum = 0
iStr = 0
iBoolean = 0

For Each rCell In rCol.Cells
If rCell.Value <> "" Then
If rCell.Value = True Or rCell.Value = False Then
iBoolean = iBoolean + 1
Else
If IsNumeric(rCell.Value) Then
iNum = iNum + 1
Else
iStr = iStr + 1
End If
End If
End If
Next rCell

If iNum = iUsed Then
MsgBox ("Column " & Chr(64 + rCol.Column) & " contains only NUMERIC values.")
ElseIf iStr = iUsed Then
MsgBox ("Column " & Chr(64 + rCol.Column) & " contains only TEXT values.")
ElseIf iBoolean = iUsed Then
MsgBox ("Column " & Chr(64 + rCol.Column) & " contains only BOOLEAN values.")
Else
Dim strMsg As String
strMsg = "Column " & Chr(64 + rCol.Column) & " contains inconsistent data types."
strMsg = strMsg & vbCr & vbCr
If iNum <> 0 Then strMsg = strMsg & " " & iNum & " NUMERIC values" & vbCr
If iStr <> 0 Then strMsg = strMsg & " " & iStr & " TEXT values" & vbCr
If iBoolean <> 0 Then strMsg = strMsg & " " & iBoolean & " BOOLEAN values"
MsgBox (strMsg)
End If
Next strCol
End Sub

[MWE]

many thanks for the ideas presented. I tried a lot of approaches and incorporated some of the ideas suggested. But in the end the simplest and most compact seemed to run as fast as anything else I tried (test was a 25,000 row sheet with most cols containing mostly a single var type), so I am going with:
Function xlColType(SName As String, ColNum As Long, StartRow As Long, TypesFound)
'
'************************************************************************** **************
' Title xlColType
' Target Application: MS Excel
' Function determines the basic type of variable most common in a given col
' and returns a number indicating the variable type:
' 1 numeric
' 2 date
' 3 boolean
' 4 text (assumed if not one of the others)
' 5 blank
'
' and an array containing # found for each type
' Limitations: 1) does not differentiate among various types of numerics, e.g.,
' Integer, Long, Single, Double, etc
' 2) ignores variable types that would not be a single cell, e.g.,
' object and arrays or errors
' 3) examines all cells in col from StartRow to last populated cell
' Passed Values:
' SName name of worksheet that includes target column
' ColNum number of column to be examined
' StartRow row # at which examination starts (in case some col header info
' is not relevant
' TypesFound array of length [1 to 5] returned with # found for each type as
' defined above
' Public/Private Variables/Objects used: NONE
' VB/VBA procedures called:
' VarType
' MATools/MWETools procedures called:
' MaxValInArray determines max val in an array or index for that max val
' xlLastCellinCol determines last populated cell in col
' External Files Accessed: NONE
' Orig Date 09-Nov-2009
' Orig Author MWE
' HISTORY
'
'************************************************************************** **************
'
'
Dim I As Long
Dim IsType(5) As Long
Dim xlsheet As Worksheet

Set xlsheet = Worksheets(SName)
'
' sequence down rows of target col examining cells
'
For I = StartRow To xlLastCellinCol(SName, ColNum)
Select Case VarType(xlsheet.Cells(I, ColNum))
Case Is = 0, 1
IsType(5) = IsType(5) + 1
Case Is = 2, 3, 4, 5, 6, 14 ' numeric
IsType(1) = IsType(1) + 1
Case Is = 7 ' date
IsType(2) = IsType(2) + 1
Case Is = 8 ' string
IsType(4) = IsType(4) + 1
Case Is = 11 ' boolean
IsType(3) = IsType(3) + 1
Case Else ' not relevant
End Select
Next I
'
' determine index for IsType with most counts
'
xlColType = MaxValinArray(IsType, 2)
'
' copy IsType Array to TypesFound array
'
For I = 1 To 5
TypesFound(I) = IsType(I)
Next I

CleanUp:

Set xlsheet = Nothing

End Function