I’ve been doing some sort of office automation and Excel programming in one form or another since 1995, and still have the book entitled Microsoft Excel Visual Basic for Applications Step by Step version 5 for Windows, published in 1994…you can still purchase this thing? Wow. (Get the used one – it’s a steal going for $.01 LMAO). Anyway, so I’ve built some cool stuff in the day, and some crap as well, and I guess most of it has been crap, but that’s beside the point. In all of this code, I’ve never really built many classes or objects; I figure that there was no need, and VBA wasn’t truly OOP anyway. And, from what I’ve seen, it still isn’t. But, doing a project the other day, I created a class to validate items in cells on a spreadsheet that would eventually be sent to SQL Server. I didn’t implemented this in my project, but I thought it was cool, so I’m posting it. It’s not finished either, so take it and run with it. Maybe someone will use the idea, hell I don’t know. I’ve posted a few things lately on Excel VBA, and have had a few readers and comments, so I figured I’d add this as well.
Here are the steps to wiring this thing up:
(1) The database schema - will hold the validation rules. You could put these in another spreadsheet, hard code them in the file, or do what I’ve done, which is take them and put them in a SQL Server table. You can find the script inside of the VALIDATE_EXCEL_DATABASE.sql file below. Make sure and change the file placement, unless you have letter drives matching mine.
(2) The Class object in Excel - Open Excel, and create a class called Validater (catchy name I know right on). Here’s the code for “Validater”":
Option Explicit
Private m_ColumnName As String
Private m_WorksheetName As String
Private m_ColumnPosition As Integer
Private m_IsValidated As Boolean
Private m_LengthRule As Integer
Private m_StringToParse As String
Private m_CountTrys As Integer
Private Function GetRowcount(wks As Worksheet) As Double
Dim myrange As Range
Set myrange = Columns("a:a")
Set wks = Worksheets(m_WorksheetName)
GetRowcount = Application.WorksheetFunction.CountA(myrange)
End Function
Public Sub Validate(ValidationType As String)
Dim cnt As Double, introw As Double
Dim wks As Worksheet
Dim obj As Variant
Dim CountTrys As Integer
Dim tryMessage As String
Dim s As String
Dim pos As Integer
tryMessage = "Error in Column " & m_ColumnPosition & " - row(s) "
cnt = GetRowcount(wks)
If ValidationType = "ValidateColumnLength" Then
For introw = 2# To cnt
obj = wks.Cells(introw, m_ColumnPosition)
s = Len(CStr(obj))
If s > m_LengthRule Then
tryMessage = tryMessage & CStr(introw) & ","
Me.CountTrys = Me.CountTrys + 1
If Me.CountTrys > 10 Then
MsgBox "Too many errors to validate. Check column position " & CStr(m_ColumnPosition) _
& " and fix data length", vbCritical, "Errors on Upload"
Exit Sub
End If
End If
Next introw
ElseIf ValidationType = "ValidateList" Then
For introw = 2# To cnt
pos = 0 '''
obj = wks.Cells(introw, m_ColumnPosition)
pos = InStr(m_StringToParse, obj)
If pos = 0 Then '''
tryMessage = tryMessage & CStr(introw) & ","
Me.CountTrys = Me.CountTrys + 1
If Me.CountTrys > 10 Then
MsgBox "Too many errors to validate. Check column position " & CStr(m_ColumnPosition) _
& " and fix data values.", vbCritical, "Errors on Upload"
Exit Sub
End If
End If
Next introw
ElseIf ValidationType = "ValidatePosition" Then
For introw = 2# To cnt
obj = wks.Cells(introw, m_ColumnPosition)
s = Left(CStr(obj), 1) 'Hardcoded starting position
If s <> m_StringToParse Then
tryMessage = tryMessage & CStr(introw) & ","
Me.CountTrys = Me.CountTrys + 1
If Me.CountTrys > 10 Then
MsgBox "Too many errors to validate. Check column position " & CStr(m_ColumnPosition) _
& " and fix data length", vbCritical, "Errors on Upload"
Exit Sub
End If
End If
Next introw
ElseIf ValidationType = "ValidateNULLs" Then
For introw = 2# To cnt
obj = wks.Cells(introw, m_ColumnPosition)
s = obj 'Hardcoded starting position
If s = "" Then
tryMessage = tryMessage & CStr(introw) & ","
Me.CountTrys = Me.CountTrys + 1
If Me.CountTrys > 10 Then
MsgBox "Too many errors to validate. Check column position " & CStr(m_ColumnPosition) _
& " and fix data length", vbCritical, "Errors on Upload"
Exit Sub
End If
End If
Next introw
End If
tryMessage = Mid(tryMessage, 1, Len(tryMessage) - 1)
If Me.CountTrys >= 1 Then
MsgBox tryMessage & vbCrLf & "Ending Execution - no rows uploaded", vbCritical, "Data Validation Error!"
Else
m_IsValidated = True
End If
End Sub
Public Property Get WorksheetName() As String
WorksheetName = m_WorksheetName
End Property
Public Property Let WorksheetName(value As String)
m_WorksheetName = value
End Property
Public Property Let ColumnPosition(value As Integer)
m_ColumnPosition = value
End Property
Public Property Get IsValidated() As Boolean
IsValidated = m_IsValidated
End Property
Public Property Let LengthRule(value As Integer)
m_LengthRule = value
End Property
Public Property Let StringToParse(value As String)
m_StringToParse = value
End Property
Public Property Get CountTrys() As Integer
CountTrys = m_CountTrys
End Property
Public Property Let CountTrys(value As Integer)
m_CountTrys = value
End Property
The guts of this is a method called Validate. I could have made this a bit cleaner, and used variant types and IsMissing to mimic an overloaded method, but I didn’t, so it is what it is.
(3) Create a module - (mine was left as default name “Module 1” and insert this code:
Public Sub sqlconnection(ByRef rs As ADODB.Recordset, cn As ADODB.Connection, strConn As String)
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
strConn = "PROVIDER=SQLOLEDB;"
strConn = strConn & "DATA SOURCE=sqlvm1;INITIAL CATALOG=_;"
strConn = strConn & " INTEGRATED SECURITY=sspi;"
cn.Open strConn
End Sub
(4) Create a client to instantiate the class – this goes in, for our example, a spreadsheet called “Accts”.
Private Sub ProcessData_Click()
MsgBox "Upload completed successfully!", vbInformation, "Budget Tool"
ValidateData.Enabled = True
' ProcessData.Enabled = False
Range("A2:N1000").Select
' Selection.ClearContents
Range("A2").Select
End Sub
Private Sub ValidateData_Click()
Dim cn As ADODB.Connection
Dim fldloop As ADODB.Field
Dim rs As ADODB.Recordset
Dim strConn As String
Dim ColumnPosition As Integer
Dim LengthRule As Integer
Dim WorksheetName As String
Dim i As Integer
Dim NumberOfErrors As Integer
Dim ColPosOUT As Integer
Dim ColRuleOUT As String
Dim RuleTypeOUT As String
Dim p1 As ADODB.Parameter
Dim wks As Worksheet
Set cmd = New ADODB.Command
WorksheetName = ActiveSheet.Name
Application.ScreenUpdating = False
Call Module1.sqlconnection(rs, cn, strConn)
Set cmd.ActiveConnection = cn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "usp_FetchValidation"
Set p1 = cmd.CreateParameter("@WorksheetName", adVarWChar, adParamInput, 255)
p1.value = WorksheetName
cmd.Parameters.Append p1
Set rs = cmd.Execute
While Not rs.EOF
Dim validater As validater
Set validater = New validater
RuleTypeOUT = rs.Fields(0).value
ColPosOUT = rs.Fields(1).value
ColRuleOUT = rs.Fields(2).value
If RuleTypeOUT = "ValidateColumnLength" Then
validater.ColumnPosition = ColPosOUT
validater.LengthRule = ColRuleOUT
validater.WorksheetName = WorksheetName
validater.Validate ("ValidateColumnLength")
NumberOfErrors = NumberOfErrors + validater.CountTrys
ElseIf RuleTypeOUT = "ValidateList" Then
validater.ColumnPosition = ColPosOUT
validater.StringToParse = ColRuleOUT
validater.WorksheetName = WorksheetName
validater.Validate ("ValidateList")
NumberOfErrors = NumberOfErrors + validater.CountTrys
ElseIf RuleTypeOUT = "ValidatePosition" Then
validater.ColumnPosition = ColPosOUT
validater.StringToParse = ColRuleOUT
validater.WorksheetName = WorksheetName
validater.Validate ("ValidatePosition")
NumberOfErrors = NumberOfErrors + validater.CountTrys
ElseIf RuleTypeOUT = "ValidateNULLs" Then
validater.ColumnPosition = ColPosOUT
validater.WorksheetName = WorksheetName
validater.Validate ("ValidateNULLs")
NumberOfErrors = NumberOfErrors + validater.CountTrys
End If
If NumberOfErrors > 0 Then
Exit Sub
End If
rs.MoveNext
Wend
If validater.IsValidated = True And NumberOfErrors < 1 Then
MsgBox "Validation Successful!", vbInformation, "Budget Tool"
End If
Set wks = Nothing
End Sub
(5) Create the stored procedure that returns validation rules to Excel:
USE [_]
GO
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
IF EXISTS (SELECT * FROM sys.objects WHERE object_id
= OBJECT_ID(N'[dbo].[usp_FetchValidation]') AND type in (N'P', N'PC'))
BEGIN
EXEC dbo.sp_executesql @statement
= N'ALTER PROCEDURE [dbo].[usp_FetchValidation] @WorksheetName varchar (255)
AS
SET NOCOUNT ON
SET TRANSACTION ISOLATION LEVEL READ UNCOMMITTED
SELECT r.RuleType
,x.TableColumnNumber
,x.RuleValue
FROM tbl___ValidationTable T
INNER JOIN tbl___ValidationRuleAssociation x
on t.RuleTableID = x.RuleTableID
INNER JOIN tbl___ValidationRule r
on r.RuleID = x.RuleID
WHERE RuleTablename = @WorksheetName
AND R.IsActiveRule & T.IsActiveTable=1;
'
END
So first, run the stored procedure and you’ll get the following output. These are the validation rules that will go to Excel and be consumed by the class object. You can see that for this spreadsheet, I have a rule called ValidateColumnLength; it goes to column 1 and RuleValue has a value of 5, meaning that it cannot be longer than 5 in length or it will generate an error. The other values have a RuleValue of Nulls, so those go into the method with an argument “Nulls”. If a NULL is found in columns 2-5, it will generate an error. As I said, this isn’t finished by any stretch, so don’t send any hate mail that it has holes.
After you have changed your server name in the VBA code, create a button to fire off the ProcessData_Click() routine. Mine looks like this – I’ve added a “row” of data into the spreadsheet, and fire it off:
If I put a value in the first column longer than 5 in length, I get this:
Note that I created this little prototype to stop after a certain number of errors. I guess I could have changed it:
Let’s try just the first column. I’ll put 15,000 rows in it to validate. Pretty fast!
Put eight columns greater than length of 5 and you get this:
And put more than 10 and you get this one:
So, the next time you are doing some Excel automation and sending data to SQL Server, and need a way to validate what’s going to be sent to the database, try adding this code and see if it won’t help. Expand this and make it better…I’m done with it! Make sure and get the script below!!!
Thanks for reading,
Lee
------------------------
My ending sounds like one of those from a bass fishing show on TV
Code for the database and tables
3a3c77a0-f90e-4415-b292-64b534d2881e|0|.0