Test for 3 types of data

  • Thread starter Thread starter Stuart
  • Start date Start date
S

Stuart

I would like to test a cell such that if any of 3 criteria
are met, then the cell is included in the routine.

For Each Cell In DataRange
If Cell.Value = a single capital letter
Or Cell.Value = an integer between 1 and 99
Or Cell.Value = a combination of the two ( ie D99) Then
code etc
End If
Next

How can I achieve this please?

Regards.
 
Sub test()
Dim R As Range
For Each R In Selection
Select Case ValCategory(R)
Case 1
MsgBox R.Address & Chr(10) _
& "single cap letter " & R.Value
Case 2
MsgBox R.Address & Chr(10) _
& "number " & R.Value
Case 3
MsgBox R.Address & Chr(10) _
& "combination " & R.Value
Case Else
MsgBox R.Value & " useless"
End Select
Next
End Sub

Function ValCategory(R As Range) As Byte
'1 = capital letter
'2 = number 1 to 99
'3 = 1 + 2
'4 = something else
Select Case Len(CStr(R.Value))
Case 1
Select Case Asc(R.Value)
Case 48 To 57
ValCategory = 2
Case 64 To 90
ValCategory = 1
Case Else
ValCategory = 4
End Select
Case 2
If IsNumeric(R.Value) Then
Select Case R.Value
Case 1 To 99
ValCategory = 2
Case Else
ValCategory = 4
End Select
Else
ValCategory = 4
End If
Case 3
Select Case Asc(R.Value)
Case 64 To 90
If IsNumeric(Mid(R.Value, 2)) Then
Select Case Val((Mid(R.Value, 2)))
Case 1 To 99
ValCategory = 3
Case Else
ValCategory = 4
End Select
Else
ValCategory = 4
End If
Case Else
ValCategory = 4
End Select
Case Else
ValCategory = 4
End Select
End Function
 
Many thanks.

In my Selection, most of the cells should be empty, and
most that hold data, should hold valid data. On that basis
(with a hard-coded range), I have:

With etc
.Range("H2:J250").Select
For Each R In Selection
If Not IsEmpty(R) Then
Select Case ValCategory(R)

how can I then go on to say:
If Not Case 4 Then
code
End If ' it was Case 4, so do nothing
End If
Next 'cell in the Selection

Regards and thanks.
 
Hi again

Here's a more complete setup. Test1 calls a different macro (1, 2 or 3) depending on the
content category. Test2 calls the same code for all three "if not 4". So place your code
into the proper Macro1 (and/or 2 or 3). Note that the one-cell range is passed to them, so
use R and not ActiveCell or Selection there. I've also removed your "select", so the user
is not bothered with his cursor being moved. Put it back if you disagree.

Sub test1()
Dim R As Range
For Each R In Range("H2:J250")
If Not IsEmpty(R) Then
Select Case ValCategory(R)
Case 1
Call Macro1(R)
Case 2
Call Macro2(R)
Case 3
Call Macro3(R)
Case Else
End Select
End If
Next
End Sub


Sub test2()
Dim R As Range
For Each R In Range("H2:J250")
If Not IsEmpty(R) Then
Select Case ValCategory(R)
Case 1 To 3
Call Macro1(R)
Case Else
End Select
End If
Next
End Sub

Sub Macro1(R As Range)
MsgBox R.Address & Chr(10) & R.Value, , "Macro1"
End Sub

Sub Macro2(R As Range)
MsgBox R.Address & Chr(10) & R.Value, , "Macro2"
End Sub

Sub Macro3(R As Range)
MsgBox R.Address & Chr(10) & R.Value, , "Macro3"
End Sub

Function ValCategory(R As Range) As Byte
'1 = capital letter
'2 = number 1 to 99
'3 = 1 + 2
'4 = something else
Select Case Len(CStr(R.Value))
Case 1
Select Case Asc(R.Value)
Case 48 To 57
ValCategory = 2
Case 64 To 90
ValCategory = 1
Case Else
ValCategory = 4
End Select
Case 2
If IsNumeric(R.Value) Then
Select Case R.Value
Case 1 To 99
ValCategory = 2
Case Else
ValCategory = 4
End Select
Else
ValCategory = 4
End If
Case 3
Select Case Asc(R.Value)
Case 64 To 90
If IsNumeric(Mid(R.Value, 2)) Then
Select Case Val((Mid(R.Value, 2)))
Case 1 To 99
ValCategory = 3
Case Else
ValCategory = 4
End Select
Else
ValCategory = 4
End If
Case Else
ValCategory = 4
End Select
Case Else
ValCategory = 4
End Select
End Function
 
Would any ideas here help? This checks A1:A100 and just puts an "Ok" in
Column B if it finds a match.
I didn't understand Case 4, so this just skips blank cells. You could make
a second pass on just blank cells if you want.

Sub Demo()
'// Dana DeLouis
Dim BigRng As Range
Dim cell As Range

Const CapLetter As String = "[A-Z]"
Const OneDigit As String = "#"
Const TwoDigit As String = "##"
Const Cap_OneDigit As String = "[A-Z]#"
Const Cap_TwoDigits As String = "[A-Z]##"


On Error Resume Next
Set BigRng = [A1:A100].SpecialCells(xlCellTypeConstants)
If BigRng Is Nothing Then Exit Sub
On Error GoTo 0

For Each cell In BigRng
If _
cell Like CapLetter Or _
cell Like OneDigit Or _
cell Like TwoDigit Or _
cell Like Cap_OneDigit Or _
cell Like Cap_TwoDigits Then _

cell.Offset(0, 1) = "Ok"
End If

Next cell
End Sub


--
Dana DeLouis
Using Windows XP & Office XP
= = = = = = = = = = = = = = = = =

<snip>
 
Back
Top