CODEWITHSUNDEEP
excelexcel-formulaexcel-2010vba
user1624926
user1624926

Reputation: 451

Excel - resizing

I have wrote the below UDF and applied a function (GetDisplayName) I found on line. When I try to Lock the cells and hard code columns to the right (A - J) I keep getting a #value. It's due to the rCell.Resize. Can you please let me what I'm doing wrong. I'm putting the UDF in column I and referencing column J (J2). I want to lock and hard code A2:J2. Appreciate any help.

    Option Explicit
    Const sPassword = "Test123"
    Public Function ApplySignOff(rCell As Range) As String

    Dim sDisplayName As String
    Dim SingleSignOffCheck As String


    sDisplayName = GetDisplayName(Environ("USERNAME"))
    SingleSignOffCheck = Environ("USERDOMAIN") & "\" & Environ("USERNAME")

    Application.ScreenUpdating = False

        Unprtsht

        If Trim(rCell) = vbNullString Then

            ApplySignOff = vbNullString

        Else

            ApplySignOff = sDisplayName & " (" & SingleSignOffCheck & "  " & Now & ")"
            rCell.Resize(0, -10).Locked = True
            rCell.Resize(0, -10).Copy
            rCell.Resize(0, -10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,      SkipBlanks _
                :=False, Transpose:=False
            rCell.Resize(0, -10).Paste
            Application.CutCopyMode = False

        End If

        Prtsht

    Application.ScreenUpdating = True

    Set rCell = Nothing

End Function

Public Function GetDisplayName(sAMAccountName As Variant) As String
Dim objconn As Object
Dim objCommand As Object
Dim objRoot As Object
Dim objDomain As Object
Dim objRS As Object
Dim strDomain As String
Dim strSQL As String
Dim varSearch As Variant

On Error GoTo PROC_ERR

GetDisplayName = ""

Set objconn = CreateObject("ADODB.Connection")
objconn.Provider = "ADsDSOObject"
objconn.Open "Active Directory Provider"

Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objconn

Set objRoot = GetObject("LDAP://rootDSE")
strDomain = objRoot.get("defaultNamingContext")
Set objDomain = GetObject("LDAP://" & strDomain)
Const sPassword = "Test123"

strSQL = "SELECT displayname FROM 'LDAP://" & strDomain & "'" & _
    " WHERE sAMAccountName='" & sAMAccountName & "'"
objCommand.CommandText = strSQL

Set objRS = objCommand.Execute
If objRS.RecordCount > 0 Then
    With objRS
        .MoveFirst
        While Not .EOF
            GetDisplayName = !DisplayName
            .MoveNext
        Wend
        .Close
    End With
End If

PROC_EXIT:
Set objRS = Nothing
Set objconn = Nothing
Set objCommand = Nothing
Set objRoot = Nothing
Set objDomain = Nothing


Exit Function

PROC_ERR:
MsgBox "Error getting display name for " & sAMAccountName & ".  Error " & Err.Number & ": " & Err.Description, vbCritical
Resume PROC_EXIT

End Function
Public Function Unprtsht()
ActiveSheet.Unprotect sPassword
End Function

Public Function Prtsht()
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=sPassword
End Function

Upvotes: 1

Views: 63

Answers (2)

Charles Williams
Charles Williams

Reputation: 23550

A UDF is only allowed to modify the cell(s) it is entered into: so it cannot do the hard-coding you are trying to do.

Upvotes: 2

Dave
Dave

Reputation: 1643

You need to redefine the current range using the Set keyword as below. The range size is not relative to the current size of the range so it would attempt to resize to 0 columns by -10 rows. You could store the value of rCell.columns.count and rCell.rows.count in variables then use

set rCell = rCell.Resize(columnCount, rowCount)

then refer to rCell

rCell.locked = True
rCell.copy
...etc

Upvotes: 1

Related Questions