Solved

VBA data validation optimization

Posted on 2011-09-28
6
231 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 500 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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

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:Michael74
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

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

759 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

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now