Question : VBA Set Cell/Range Properties

I would like to be able to dynamically set the properties for a cell range. I created a function to act somewhat like a wrapper so that I can enter data dynamically. Can the data in the WITH block be input dynamically?

If it is possible to make this happen, if so what is the best method to do this?

Thanks

Code Snippet:

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:



Public Function SetCellProperties(wkhsheet As String, RangeA As String, RangeB As String, pswd As String) As Boolean
    
    SetCellProperties = False
    On Error GoTo ErrorHandler
    If Len(pswd) > 0 Then
        Sheets(wkhsheet).Unprotect Password:=pswd
    End If
    
    With Range(RangeA, RangeB)
        .Font.Size = 10
        .Font.Bold = False
        .Font.Name = "Arial"
        .Borders.Color = 3
    End With
    
    If Len(pswd) > 0 Then
        Sheets(wkhsheet).Protect Password:=pswd
    End If
    
    SetCellProperties = True
    Exit Function
    
ErrorHandler:
    Exit Function
 
End Function

Open in New Window

Select All

Answer : VBA Set Cell/Range Properties

Interesting question! :)
Try the code below - you pass the additional objects and properties as strings at the end - for example:
setcellproperties("sheet1", "A1", "A2", "", "Font.Bold", True, "Font.Italic", True)

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:



Public Function SetCellProperties(wkhsheet As String, RangeA As String, RangeB As String, pswd As String, ParamArray Props()) As Boolean
    Dim rng As Range
    Dim lngIndex As Long, n As Long
    Dim vardata As Variant
    Dim objProp As Object
    SetCellProperties = False
    On Error GoTo ErrorHandler
    If Len(pswd) > 0 Then
        Sheets(wkhsheet).Unprotect Password:=pswd
    End If
    
    Set rng = Sheets(wkhsheet).Range(RangeA, RangeB)
    For lngIndex = LBound(Props) To UBound(Props) Step 2
        vardata = Split(Props(lngIndex), ".")
        n = LBound(vardata)
        If n < UBound(vardata) Then
            Set objProp = CallByName(rng, vardata(n), VbGet)
            n = n + 1
            Do While n < UBound(vardata)
                Set objProp = CallByName(objProp, vardata(n), VbGet)
            Loop
            CallByName objProp, vardata(UBound(vardata)), VbLet, Props(lngIndex + 1)
        Else
            CallByName rng, vardata(UBound(vardata)), VbLet, Props(lngIndex + 1)
        End If
    Next lngIndex
    
    If Len(pswd) > 0 Then
        Sheets(wkhsheet).Protect Password:=pswd
    End If
    
    SetCellProperties = True
    Exit Function
    
ErrorHandler:
    Exit Function
 
End Function

Open in New Window

Select All