HOW TO: VBA EXCEL, workaround the ~255 characters validation limit…

Status
Niet open voor verdere reacties.

dprod

Gebruiker
Lid geworden
2 jun 2010
Berichten
80
Beste mede-forum leden,

Zie hieronder een post die ik geschreven heb als hulpmiddel om de ~255 characters limitation te omzeilen.
Deze is in het engels omdat ik 'm eigenlijk voor een ander (engels) Forum had geschreven.
Bij vragen zie ik jullie reacties tegemoet...


VBA EXCEL, workaround the ~255 characters validation limit…

For those who wonder why Microsoft used a limitation of ~255 characters (commas included) for a list-entry in DV ref-edit box (even by VBA-code). Your code does not fail, but any characters exceeding this limit, they are not assigned to the validation list. Versions prior to 2003 do really complain when trying to set a +255 characters validation-list also, some versions won't let you "quit" the application at all! Shame on Microsoft…

Assume that you have a very large String with the “,” separator we can use VBA-code to make an Array, redirect the values of this Array to a temporary (hidden) Worksheet and setup a named Range which we will refer to in the validation list.
And what if we change the Strings value? Well… we just call the Procedure again so it will reproduce our named range/hidden worksheet.

Starting with the following code gives an idea of how this works:
Code:
Option Explicit
Public Sub ThisIsYourCode()

    Dim strOriginalString As String
    
strOriginalString = "your old string BEFORE any changes"

'CODE

If strOriginalString <> "your new string AFTER any changes" Then
    'CreateNamedRange Sub with: NEW STRING, SEPARATOR and RANGE for the Validation List.
    Call CreateNamedRange("your new string", ",", ThisWorkbook.ActiveSheet.Cells(1, 1))
    MsgBox "My validaion-list is changed!"

    'CODE

Else
    MsgBox "My validation-list has not been changed..."

    'CODE

End If
End Sub
Code:
Public Sub CreateNamedRange(ByVal strMyText As String, strSep As String, rngForValidation As Range)

    Dim ws As Worksheet
    Dim arrMyText() As String, strNamedRange As String
    Dim lng As Long

'Give the NamedRange a value
strNamedRange = "validationlist"
'Fill Array with NEW STRING, split by the SEPARATOR
arrMyText = Split(strMyText, strSep)

'Delete existing Worksheet
Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets("Temp").Delete
    On Error GoTo 0

'(Re)add Temporary Worksheet
Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
With ws
    .Name = "Temp"
    .Visible = xlSheetHidden
    'Copy each value in the Array to a Cell
    For lng = 0 To UBound(arrMyText)
        .Cells(lng + 1, 1) = arrMyText(lng)
    Next lng

'Create the NamedRange With: name = strNamedRange, refers to the Worksheet.Name("Temp") and Worksheet.Range(Row 1 in Column 1, to LastRow in Column 1)
ThisWorkbook.Names.Add strNamedRange, RefersToR1C1:="=" & ws.Name & "!R1C1:R" & ws.Cells(65536, 1).End(xlUp).Row & "C1"
'UpdateValidationList Sub with: RANGE for the Validation List, NAMEDRANGE and Standard Value
Call UpdateValidationList(rngForValidation, strNamedRange, "Select...")
End Sub
Code:
Public Sub UpdateValidationList(ByVal rngForValidation As Range, strNamedRange As String, strStandardValue As String)

    'Create the Validation List
    With rngForValidation.Validation
        .Delete
        .Add Type:=xlValidateList, _
        AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=" & strNamedRange & ""
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = "My Input Title"
        .ErrorTitle = "My Error Title"
        .InputMessage = "My Input Message"
        .ErrorMessage = "My Error Message"
        .ShowInput = True
        .ShowError = True
    End With

'Set the Standard Value
rngForValidation = strStandardValue
End Sub

Now… without users attention, there has been add a worksheet (called “Temp”), and a named Range (called “validationlist”) to the workbook. The validation list now refers to this named Range with all the used values in it. So far, this isn’t hard to understand. But what if we want to get these values from another Excel workbook, like a Database file?

I prefer using the ADODB.connection which will need you to activate the following Reference in VBE: “Microsoft ActiveX Data Objects 2.8 Library”. Some others will prefer the Workbook.Open command, make it hidden and use the Workbook_BeforeClose procedure for closing the hidden Workbook. Again, this last option brings some limitations like making the Workbook marked: “read only”. As long as a user has it opened, no one is able to make changes to the database file. Also when using different database files, it can be time spending opening and closing al these files. When using the ADODB.connection, the user imports values from (named) ranges without visually opening the Excel file, and using SQL Query’s for pulling the exact information from any table (range) in this Excel file. This is a lot faster, and other users are now able to make changes within the database file(s) as long as the ADODB.connection is closed. You are still following me? No? Let’s do this in practice…

First we need to know if the database file(s) does exist. Here comes a small Function in handy.
Code:
Public Function filefolderexists(FilePath As String) As Boolean

    On Error GoTo EarlyExit
    If Not Dir(FilePath, vbDirectory) = vbNullString Then filefolderexists = True

EarlyExit:
    On Error GoTo 0
End Function

We will use this function for checking the FilePath and returning a Boolean as True or False. Then returning the FilePath to a public variable, and set a public variable True or False when the function returns its value.
Code:
Public Sub GetDatabaseConnection()

    Dim strDatabasePath As String

'Set the (network) FilePath as String
strDatabasePath = "my networkpath\database.xls"

'Use Function with FilePath As String
If filefolderexists(strDatabasePath) Then
    'When returning True, set public variables
    strDatabaseFile = strDatabasePath
    DatabaseConnectionEstablished = True
    Else
    'When returning False, try localy
    
    'Set the (local) FilePath as String
    strDatabasePath = ThisWorkbook.Path & "\database.xls"
    
    'Use Function with FilePath As String
    If filefolderexists(strDatabasePath) Then
        'When returning True, set public variables
        strDatabaseFile = strDatabasePath
        DatabaseConnectionEstablished = True
        Else
        
        'When returning False, set public variable to False
        DatabaseConnectionEstablished = False
    End If
End If

If Not DatabaseConnectionEstablished Then
    MsgBox "No database file(s) where found!" & vbNewLine & _
            "ADODB.connection will return a connection failure; this workbook will now be closed" & _
            vbNewLine & vbNewLine & "Contact your systemadministrator"
    ThisWorkbook.Close SaveChanges:=False
End If
End Sub

At the end when finished all code-work, call the procedure when opening the Workbook:
Code:
Private Sub Workbook_Open()
    Call GetDatabaseConnection
End Sub

Now… We have checked for a network location, if it exists we use this FilePath in our local Variable. If not, we checked for a locally database file. If both does not exist the DatabaseConnectionEstablished return False, showing a MessageBox and we will close the Workbook without saving it.

We can use the following Function to create a ADODB.connection:
Code:
Public Function conn(ByVal sqlQuery As String, sqlPath As String) As ADODB.Recordset

    Dim rs As New ADODB.Recordset
    Dim cn As New ADODB.Connection
    Dim strSQL As String

'Set the following connection
With cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    'sqlPath is the strDatabaseFile, HDR=Yes, this means the first row in a Range are Headers
    .ConnectionString = "Data Source=" & sqlPath & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=Yes;"""
    .Open
End With

'Create the sqlQuery, sqlQuery As String
strSQL = "SELECT * FROM " & sqlQuery
rs.Open strSQL, cn, adOpenStatic, adLockReadOnly

    'Return Recordset to the Functions ADODB.Recordset
    Set conn = rs

End Function

Use this Function for connecting to the database file(s), and return a Recordset of the Range which is given in the code below. This (named) Range is used in the function as the sqlQuery and is nearly the same as a normal SQL-based connectionstring.

When we change the CreateNamedRange Procedure (see the beginning of this post) for the GetDatabaseValues Procedure, and call this new Procedure in your code like below, all values in the NamedRange from your database file(s) will be listed in your validation list. In fact… we have only changed the Array, filled with Split using a Separator, for a Recordset that returns all values within the NamedRange of the database file that we have set in the sqlQuery String.

Code:
Public Sub ThisIsYourCode()

    Dim strOriginalString As String
    
strOriginalString = "your old string BEFORE any changes"

'CODE

If strOriginalString <> "your new string AFTER any changes" Then
    'GetDatabaseValues Sub with: RANGE for the Validation List.
    Call GetDatabaseValues(ThisWorkbook.ActiveSheet.Cells(1, 1))
    MsgBox "My validaion-list is changed!"

    'CODE

Else
    MsgBox "My validation-list has not been changed..."

    'CODE

End If
End Sub
Code:
Public Sub GetDatabaseValues(ByVal rngForValidation As Range)

    Dim rs As New ADODB.Recordset
    Dim strSqlQuery As String, strNamedRange As String, strDatabaseRange As String
    Dim ws As Worksheet
    Dim intCounter As Integer

'Give the NamedRange a value
strNamedRange = "validationlist"
'Here we will use a NamedRange in the Database file
strDatabaseRange = "myvalues"

'Delete existing Worksheet
Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets("Temp").Delete
    On Error GoTo 0

'(Re)add Temporary Worksheet
Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
With ws
    .Name = "Temp"
    .Visible = xlSheetHidden
    'Set the strSqlQuery, this can be a NamedRange, a UsedRange or a given Range
    strSqlQuery = strDatabaseRange
    'Create a Recordset with the used sqlQuery
    Set rs = conn(strSqlQuery, strDatabaseFile)
        'Copy each value in the Recordset to a Cell
        For intCounter = 0 To rs.RecordCount - 1
            'rs(0) will be the first column in the range of the Recordset, rs(1) = second, rs(2) = third, so on...
            .Cells(intCounter + 1, 1) = rs(0)
            rs.MoveNext
        Next

    'Close the Recordset
    rs.Close
    rs.ActiveConnection = Nothing
    Set rs = Nothing

'Create the NamedRange With: name = strNamedRange, refers to the Worksheet.Name("Temp") and Worksheet.Range(Row 1 in Column 1, to LastRow in Column 1)
ThisWorkbook.Names.Add strNamedRange, RefersToR1C1:="=" & ws.Name & "!R1C1:R" & ws.Cells(65536, 1).End(xlUp).Row & "C1"
'UpdateValidationList Sub with: RANGE for the Validation List, NAMEDRANGE and Standard Value
Call UpdateValidationList(rngForValidation, strNamedRange, "Select...")
End With
End Sub
Code:
Public Sub UpdateValidationList(ByVal rngForValidation As Range, strNamedRange As String, strStandardValue As String)

    'Create the Validation List
    With rngForValidation.Validation
        .Delete
        .Add Type:=xlValidateList, _
        AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=" & strNamedRange & ""
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = "My Input Title"
        .ErrorTitle = "My Error Title"
        .InputMessage = "My Input Message"
        .ErrorMessage = "My Error Message"
        .ShowInput = True
        .ShowError = True
    End With

'Set the Standard Value
rngForValidation = strStandardValue
End Sub

Learn more about ADODB, by googlin’ the internet. There are a lot of options for generating detailed output from large database files, like using the SELECT * FROM NamedRange WHERE ColumnName=’myvalue’. This will only result in a Recordset with the exact records that matches “myvalue” in the specific ColumnName.

Ok, there is an extra Worksheet which is hidden, and yes… this will cost you a little amount of extra kb’s in your Workbook file. But look at the bright side of life: no more limitations, unlimited amount of values in your validation list. No opening and closing Workbook(s) that will slowdown your system/working process. And changing the database file(s) any second!

Greetings,
dProd
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan