0

I have a custom excel function `GetADUser' which takes a Username as input returns several Active Directory Attributes likes Firstname, Surname, SAM Account Name, Distinguished Name.

How can I get these attributes into cells to the left and right of the cell which holds the forumla. ie:

enter image description here

Public Function GetADUser(UserName As String) As String

Dim mycell As Range

Set rootDSE = GetObject("LDAP://RootDSE")

Base = "<LDAP://" & rootDSE.Get("defaultNamingContext") & ">"
'filter on user objects with the given account name
fltr = "(&(objectClass=user)(objectCategory=Person)" & _
        "(sAMAccountName=" & UserName & "))"
'add other attributes according to your requirements
attr = "distinguishedName,sn,mobile,sAMAccountName,GivenName,l,postOfficeBox"
Scope = "subtree"

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

Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = conn
cmd.CommandText = Base & ";" & fltr & ";" & attr & ";" & Scope

  Set rs = cmd.Execute

  arrPOBox = rs.Fields("postOfficeBox").Value
  Rank = CStr(arrPOBox(0))

  ActiveCell.Offset(0, -1).Value = (rs.Fields("sn").Value)
  ActiveCell.Offset(0, -2).Value = (rs.Fields("GivenName").Value)
  ActiveCell.Offset(0, 2).Value = (rs.Fields("l").Value)
  ActiveCell.Offset(0, 1).Value = (rs.Fields("mobile").Value)

rs.Close
conn.Close

GetADUser = GetADUser

End Function

However ActiveCell is not available in Functions.

I did read a way to return a variant instead of String, but it involved CTRL-SHIFT-ENTER to split out the values, which all went to the right of the cell holding the formula. I don't want to make a call to Active Directory for each cell.

Is there a function or procedure that could be implemented such that when a user exits a cell in the username column the other relative cells are populated.

UPDATE

This should have been detailed in the original question, but the user name cells could be in any sheet in the Workbook, and not a continuous set of cells in one of four possible columns. (see yellow cells for example)

enter image description here

The sheet names could also be changed.

The Intersect method has a limit (30) to the ranges it can take.

I considered regex since the username is always [a-z]{4}[a-z]{2} but then it triggers on every cell.

How would I do the intersect?

Al Grant
  • 2,102
  • 1
  • 26
  • 49
  • 2
    As a general rule, it is not permitted for a *Formula* to modify the contents of other cells. – David Zemens Jun 17 '19 at 20:08
  • 3
    A function is a function, i.e. it is supposed to return a value and not modify several cells. What you want here is a macro, not a function. Note that there may be some hacks to make the function modify other cells but that would be, in fact, an hack. – Matteo NNZ Jun 17 '19 at 20:13
  • 2
    Oh no... don't start this again! Technically a UDF CAN be used to modify another cell (see [here](https://stackoverflow.com/questions/23433096/using-a-udf-in-excel-to-update-the-worksheet)) but really you shouldn't. – dwirony Jun 17 '19 at 20:15
  • 1
    If your function returns an array you can populate the whole row using it as an array formula (and move your username column to be either end of the row) – Tim Williams Jun 17 '19 at 20:15
  • @TimWilliams yes, but I can only populate to the right as opposed to left and right? – Al Grant Jun 17 '19 at 20:17
  • Is it important for username to be where it is? – Tim Williams Jun 17 '19 at 20:17
  • 3
    Using the Worksheet_Change event might also be a good avenue to explore – Tim Williams Jun 17 '19 at 20:18
  • @TimWilliams I am enhancing a very large existing template, moving username is not desirable. – Al Grant Jun 17 '19 at 20:19
  • 1
    In that case I'd use a Sub and not a function - the change event would work fine here. – Tim Williams Jun 17 '19 at 20:28
  • @Al you would put the formula in range `A2:E2`. You would write the UDF to return an array with the fields in the position you want. If updating the template is a big task, write a Sub to do that for you – chris neilsen Jun 17 '19 at 20:28
  • @TimWilliams Worksheet_Change ActiveCell returns the new cell address not the cell that is being left? – Al Grant Jun 17 '19 at 21:26
  • The `Target` parameter in the Worksheet_Change events holds the range which got changed - if that range intersects with the UserName column then run your code to update that row/those rows. – Tim Williams Jun 17 '19 at 21:46

1 Answers1

1

Something like this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, c As Range

    'any updates to username(s)?
    Set rng = Application.Intersect(Me.Range("C2:C1000"), Target)
    If Not rng Is Nothing Then
        Application.EnableEvents = False '<< don't re-trigger the event
        For Each c In rng.Cells
            UpdateAdInfo c  'update the row for this user
        Next c
        Application.EnableEvents = True '<< re-enable events
    End If
End Sub




Public Sub UpdateAdInfo(rngUserName As Range)

    'clear existing data
    rngUserName.EntireRow.Range("A1:B1,D1:E1").ClearContents '<< note range is relative to row, not to sheet

    If Len(rngUserName.Value) = 0 Then Exit Sub 'no username entered, or was deleted

    '...
    '...snipped for clarity: open the recordset using rngUserName.Value
    '...

    Set rs = cmd.Execute

    With rngUserName.EntireRow
        .Cells(1).Value = rs.Fields("GivenName").Value
        .Cells(2).Value = rs.Fields("sn").Value
        'etc etc
    End With

    rs.Close
    conn.Close
End Sub
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • is there anyway to make Cells(1).Value a relative reference to the original cell that was the target? Like Offset? – Al Grant Jun 17 '19 at 23:06
  • It's already that in the code I posted: every changed cell in ColC is passed to `UpdateAdInfo` as the parameter `rngUserName`, and `rngUserName.EntireRow` represents the specific row for that UserName cell, so `.Cells(1)` is ColA on that row. – Tim Williams Jun 17 '19 at 23:35
  • I have used With rngUserName .OffSet(0, -3).Value = etc instead of .Cells(1).Value - this works nicely. – Al Grant Jun 18 '19 at 01:54