Excel Setting Paramaters  (scroll to top)

Set your values of the parameter on an excel sheet to be able to change configurations easy without to go into the vba code. The idea is to have a sheet with unique references and a value which can get read and written by a vba function. Including a possible grouping to be able to use the same unique references in more than one group with other values.

Step 01: Create a worksheet with the wished parameters and name the tab "Def-Settings"

Step 02: Name the title for Column A "Group names" (you can use titles as you like)

Step 03:Title for Column B "VBA ID" - this column is for the unique references, I used same name as in VBA for better transparence

Step 04: Title for Column C "Values" - this columns has the values you read or even write

Step 05: Title for Column D "Comment" - has no function just for better transparence and good documentation

Step 06: In case you like groups enter as first a group name (has to be a line above the first paramater) I used groups only for visibility but not as read option

Step 07: Write in Column B your parameter - best same name as you use in vba

Step 08: Write in Column C the wished values for each parameter and add in Column C comment if you like

This is how it can look like - just as an idea

Step 09: Open the VBA-Windows (Menue Developer)

Step 10: Add a new Module and add the Function as following

Option Explicit

Public strgThisWorkbook$ ' name of this workbook
Public bytgSettingStat As Byte ' status of found parameter & value
Public bytgSettingStatMax As Byte ' highest status of found parameter & value - reset in caller procedure

Function Setting$(strPar$, Optional bytFlag As Byte, Optional varValue, Optional strSheetSet$, Optional strCPar$, Optional strCVal$, Optional strCKey$, Optional strProz$)
' Read and Write Settings in Sheets
'    Examples of use:
'       strToReadValue$ = Setting$(strToReadParamater$)
'       intToReadValue$ = val(Setting$(intToReadValue%))
'       strToReadValue$ = Setting$(strToReadValue$,2) ' = can be empty without a error message
'       strToReadValue$ = Setting$(strToReadValue$,,strDefaultValue$) ' if not found it set a Default Value
'       strToReadValue$ = Setting$(
'       Setting$(strToWriteParameter$,3,strToWriteValue$)
'       strToReadValue$= Setting$(strToReadParameter$,,,strSettingsSheet$,,,strColumnParameter, strColumnValue)
'
' Settings$("ParameterName", bytFlag (1=Read mandatory Value (Default)) / 2=Read can be empty / 3=write), Value= Default Value or the to write Value, ParameterSheet, Column Paramternames, Columns Values, Column Group Parameter, Parameter Group
    Dim strReadVal$, strValue$
    Dim intCountRow%, intRowParam%, intStartRowSetting%, intEndRowSetting%
    Dim bytEmpty As Byte, bytWrapText As Byte

    ' Defaults and Settings
    Dim strDefaultSheetSet$, strDefaultCPar$, strDefaultCVal$, strDefaultCKey$, strDefaultValue$, strDefaultGroup$
    Dim bytDefaultFlag As Byte, bytDefaultMaxEmpty As Byte

        strDefaultSheetSet$ = "Def-Settings"
        bytDefaultFlag = 1
        strDefaultCPar$ = "B"
        strDefaultCVal$ = "C"
        strDefaultCKey$ = "A"
        strDefaultValue$ = "" ' no Value
        strDefaultGroup$ = "" ' no group just go through all
        bytDefaultMaxEmpty = 10

    bytgSettingStat = 0
    intStartRowSetting% = 1
    strPar$ = LCase(strPar$)
    bytWrapText = 11

    ' if columns for parameter and values are not defined - just set as standard
    If IsMissing(varValue) Then
        strValue$ = strDefaultValue$
    ElseIf IsNumeric(varValue) Then
        strValue$ = Str(varValue)
    Else
        strValue$ = varValue
    End If
    If strgThisWorkbook$ = "" Then strgThisWorkbook$ = ActiveWorkbook.Name
    If strSheetSet$ = "" Then strSheetSet$ = strDefaultSheetSet$
    If strProz$ = "" Then strProz$ = strDefaultGroup$
    If bytFlag = 0 Then bytFlag = bytDefaultFlag
    If strCKey$ = "" Then strCKey$ = strDefaultCKey$
    If strCPar$ = "" Then strCPar$ = strDefaultCPar$
    If strCVal$ = "" Then strCVal$ = strDefaultCVal$


    intCountRow% = Workbooks(strgThisWorkbook$).Worksheets(strSheetSet$).UsedRange.SpecialCells(xlCellTypeLastCell).Row
    intEndRowSetting% = intCountRow%

    'looking for start row of parameter group
    If strProz$ <> "" Then
        strProz$ = LCase(strProz$)
        ' search start
        For intStartRowSetting% = intStartRowSetting% To intCountRow%
            strReadVal$ = Workbooks(strgThisWorkbook$).Worksheets(strSheetSet$).Range(strCKey$ & intStartRowSetting%).Value
            strReadVal$ = LCase(strReadVal$)
            If strReadVal$ = strProz$ Then Exit For
        Next intStartRowSetting%
        ' search end (next group)
        For intEndRowSetting% = intStartRowSetting% + 1 To intCountRow%
            strReadVal$ = Workbooks(strgThisWorkbook$).Worksheets(strSheetSet$).Range(strCKey$ & intStartRowSetting%).Value
            strReadVal$ = LCase(strReadVal$)
            If strReadVal$ <> "" Then Exit For
        Next intEndRowSetting%
        intEndRowSetting% = intEndRowSetting% - 1
    End If

    For intRowParam% = intStartRowSetting% To intEndRowSetting%
        strReadVal$ = Workbooks(strgThisWorkbook$).Worksheets(strSheetSet$).Range(strCPar$ & intRowParam%).Value
        strReadVal$ = LCase(strReadVal$)
        If strReadVal$ = "" Then ' empty row
            bytEmpty = bytEmpty + 1
        ElseIf strReadVal$ = strPar$ Then
            If bytFlag = 3 Then ' write value in settings
                If Workbooks(strgThisWorkbook$).Worksheets(strSheetSet$).Range(strCVal$ & intRowParam%).WrapText = True Then bytWrapText = 21
                If ActiveCell.WrapText = True Then bytWrapText = bytWrapText + 1
                Workbooks(strgThisWorkbook$).Worksheets(strSheetSet$).Range(strCVal$ & intRowParam%).Value = strValue$
                If bytWrapText = 21 Or bytWrapText = 22 Then
                    Workbooks(strgThisWorkbook$).Worksheets(strSheetSet$).Range(strCVal$ & intRowParam%).WrapText = True
                Else
                    Workbooks(strgThisWorkbook$).Worksheets(strSheetSet$).Range(strCVal$ & intRowParam%).WrapText = False
                End If
                If bytWrapText = 12 Or bytWrapText = 22 Then
                    On Error Resume Next
                    ActiveCell.WrapText = True
                    Err.Clear
                Else
                    On Error Resume Next
                    ActiveCell.WrapText = False
                    Err.Clear
                End If
                bytgSettingStat = 1
                Exit Function
            Else
                bytgSettingStat = 1
                On Error Resume Next
                strReadVal$ = Workbooks(strgThisWorkbook$).Worksheets(strSheetSet$).Range(strCVal$ & intRowParam%).Value
                Err.Clear
                Exit For
            End If
        ElseIf bytEmpty > bytDefaultMaxEmpty Then ' exit after defined empty rows
            strReadVal$ = ""
            Exit For
        Else ' row with a definition but no the searched one
            bytEmpty = 0
            strReadVal$ = ""
        End If
    Next

    ' Check Value
    If strReadVal$ <> "" Then ' found a value
        Setting$ = strReadVal$
        bytgSettingStat = 1
        If bytgSettingStatMax < bytgSettingStat Then bytgSettingStatMax = bytgSettingStat
    Else
        If strValue$ <> "" Then ' default is set
            bytgSettingStat = 2
            If bytgSettingStatMax < bytgSettingStat Then bytgSettingStatMax = bytgSettingStat
            Setting$ = strValue$
        ElseIf bytFlag = 2 Then ' optional -> emty or not found parameters are ok
            bytgSettingStat = 3
            If bytgSettingStatMax < bytgSettingStat Then bytgSettingStatMax = bytgSettingStat
            Setting$ = ""
        Else ' mandatory but missing
            If bytgSettingStat = 1 Then
                bytgSettingStat = 5
                If bytgSettingStatMax < bytgSettingStat Then bytgSettingStatMax = bytgSettingStat
                MsgBox "value for " & strPar$ & " is empty in sheet " & strSheetSet$, vbCritical
            Else
                bytgSettingStat = 9
                If bytgSettingStatMax < bytgSettingStat Then bytgSettingStatMax = bytgSettingStat
                MsgBox "Parameter " & strPar$ & " not found in sheet " & strSheetSet$, vbCritical
            End If
            Setting$ = ""
        End If
    End If

End Function