Solved

VBA data validation optimization

Posted on 2011-09-28
6
241 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Revamp Your Training Process

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action.

 

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

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

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

How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

632 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