Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

VBA data validation optimization

Posted on 2011-09-28
6
Medium Priority
?
245 Views
Last Modified: 2012-05-12
I am doing a series of data validations. My IF statements are getting pretty tangled up. In the past I have used Select Case for some validation, however, the current routine is moving beyond my knowledge on how to set up in a Select Case Statement.

Basically I am doing several test on multiple columns of cells in a table. I want to see if all of the cell contents are upper case or lower case, test to see if there are special characters in the cell (not shown in the code example below), remove any punctuation marks in the cell containing the City (not shown in the code example below), etc.


My current IF statement is looking like this:

        If (UCase(Range(strColumn & lngCurrentRow).Value) = Range(strColumn & lngCurrentRow).Value) _
        Or (LCase(Range(strColumn & lngCurrentRow).Value) = Range(strColumn & lngCurrentRow).Value) _
        Or (UCase(Range(strAddress2Col & lngCurrentRow).Value) = Range(strAddress2Col & lngCurrentRow).Value) _
        Or (LCase(Range(strAddress2Col & lngCurrentRow).Value) = Range(strAddress2Col & lngCurrentRow).Value) _
        Or (UCase(Range(strCityCol & lngCurrentRow).Value) = Range(strCityCol & lngCurrentRow).Value) _
        Or (LCase(Range(strCityCol & lngCurrentRow).Value) = Range(strCityCol & lngCurrentRow).Value) Then

Open in new window


How can I reformat that in a Select Case or other method to make the code simpler?

0
Comment
Question by:ckelsoe
  • 3
  • 2
6 Comments
 
LVL 1

Expert Comment

by:Cazar
ID: 36720613
Try using a function similar to the following to remove unwanted characters. In the "[A-Z,a-z,0-9, ]" brackets, place the character sets you want to keep in the string.

Function stripNonAlphaNumeric(strText As String) As String

    Dim valid, test As String
    valid = ""
    test = ""

    For i = 1 To Len(strText)
        test = Mid(strText, i, 1)
        If test Like "[A-Z,a-z,0-9, ]" Then
            valid = valid & test
        End If
    Next i
   
    'Return the valid characters
    stripNonAlphaNumeric = valid

End Function
0
 

Author Comment

by:ckelsoe
ID: 36720647
I am not wanting to remove or change the data in the cells. I am highlighting the cells in the sheet that failed validation.

The rules that need to be applied to the data is as follows:

1. An address should be mixed case. If not, color the cell background Yellow for the cell that has failed this test.
2. An address cannot contain special characters. If it does  color the cell background Green for the cell that has failed this test.
3. If the first address cell is blank then color that cell background with Red

In this instance I have columns for Address1, Address2, and City.
0
 
LVL 1

Accepted Solution

by:
Cazar earned 2000 total points
ID: 36720711
Functions like the following will accomplish the tests. You'll need to specify the exact character sets you're testing for. Be sure you add a reference for the Regular Expression library.

Function mixedCase(pText As String) As Boolean
    Dim oRegEx As Object
    Set oRegEx = CreateObject("VBScript.RegExp")
    With oRegEx
        .Pattern = "^[a-zA-Z ]+$"
        validCell = .test(pText)
    End With
    Set oRegEx = Nothing
End Function

Function specialCharacters(pText As String) As Boolean
    Dim oRegEx As Object
    Set oRegEx = CreateObject("VBScript.RegExp")
    With oRegEx
        .Pattern = "^[!@#$%&(){}[]\/]+$"
        specialCharacters = .test(pText)
    End With
    Set oRegEx = Nothing
End Function

Here's how you would use the above functions:

If Not mixedCase(text) Then
    Range("A6").Interior.Color = RGB(255,255,0)
End If

If specialCharacters(text) Then
   Range("A6").Interior.Color = RGB(0,100,0)
End If
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 

Author Comment

by:ckelsoe
ID: 36724275
I applied your code as follows and cannot get it to work:


Sub TestSpecChars()

    Dim strCharsToTest As String

    strCharsToTest = "123 Main Street" ' Should Pass
    strCharsToTest = "#123 Main Street" ' Should Fail
    
    If Not specialCharacters(strCharsToTest) Then
        MsgBox "Failed"
    Else
        MsgBox "Passed"
    End If
End Sub

Sub TestMixed()

    Dim strCharsToTest As String
    
    strCharsToTest = "123 Main Street" ' Should Pass
    'strCharsToTest = "123 MAIN STREET" ' Should Fail
    'strCharsToTest = "123 main street" ' Should Fail
    
    If Not mixedCase(strCharsToTest) Then
        MsgBox "Failed"
    Else
        MsgBox "Passed"
    End If
End Sub

Function mixedCase(pText As String) As Boolean
    Dim oRegEx As Object
    Dim validcell
    Set oRegEx = CreateObject("VBScript.RegExp")
    With oRegEx
        .Pattern = "^[a-zA-Z ]+$"
        validcell = .test(pText)
    End With
    Set oRegEx = Nothing
End Function

Function specialCharacters(pText As String) As Boolean
    Dim oRegEx As Object
    Set oRegEx = CreateObject("VBScript.RegExp")
    With oRegEx
        .Pattern = "^[!@#$%&(){}[]\/]+$"
        specialCharacters = .test(pText)
    End With
    Set oRegEx = Nothing
End Function

Open in new window

I tried referencing both Microsoft VBScript Regular Expressions 1.0 and Microsoft VBScript Regular Expressions 5.5
0
 
LVL 23

Expert Comment

by:Michael Fowler
ID: 36753358
You should not need to add references as the script uses late binding and it worked fine for me

The function mixed case needs a small adjustment to make it work correctly

Just change the word "validCell " to read "mixedCase"

I have attached a test function that worked for me using Cazar's code

Michael
Function mixedCase(pText As String) As Boolean
    Dim oRegEx As Object
    Set oRegEx = CreateObject("VBScript.RegExp")
    With oRegEx
        .Pattern = "^[a-zA-Z ]+$"
        mixedCase = .test(pText)
    End With
    Set oRegEx = Nothing
End Function

Function specialCharacters(pText As String) As Boolean
    Dim oRegEx As Object
    Set oRegEx = CreateObject("VBScript.RegExp")
    With oRegEx
        .Pattern = "^[!@#$%&(){}[]\/]+$"
        specialCharacters = .test(pText)
    End With
    Set oRegEx = Nothing
End Function

Sub test()
   For Each c In Range("A1:A5")
      If mixedCase(c.Text) Then
         c.Interior.Color = vbWhite
      Else
         c.Interior.Color = RGB(255, 255, 0)
      End If
   Next
End Sub

Open in new window

0
 

Author Comment

by:ckelsoe
ID: 36814721
For some reason I am unable to get this to work.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
Microsoft's Excel has many features that most people will never need nor take advantage of.  Conditional formatting is one feature that you may find a necessity once you start using it.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

773 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question