How can I append to list in excel based on some condition?-CodePudding

I am trying to figure out the best approach to perform a routine task in excel. I have an excel file with columns as below, and it needs to be updated from time to time

ID  country  department  expense_group  Amount  approvers1  approvers2

The column approvers1 and 2 contain a list of comma separated userIDs - users who are authorized to approve the given expense up to the "Amount".

As people leave the company, move across departments, new people join in, the excel data is updated manually. I am looking at ways to simplify this task preferably with some VBA / PowerQuery.

I am looking for ways to perform the below tasks in excel. So far I think the only approach would be use VBA but would like to hear any other possible approaches

Replace a certain userID with another userID against a certain expense_group/department
Append a certain userID in a comma separated list against a certain expense_group/department
Append a certain userID in a comma separated list only where another given userID is present

Your suggestions are welcome.

CodePudding user response：

If my assumptions from the above comments are correct, please test the next code:


Sub updateUsers(rngProc As Range, strUser, strGroup As String, Optional strReplace As String, Optional userPrezent As String)
   Dim arr, arrApp1() As String, arrApp2() As String, mtch, i As Long
    arr = rngProc.Columns("D:G").Value2
    For i = 1 To UBound(arr)
        If arr(i, 1) = strGroup Then 'strReplace <> ""
             arrApp1 = Split(Replace(arr(i, 3), " ", ""), ",")
             arrApp2 = Split(Replace(arr(i, 4), " ", ""), ",")
             If strReplace <> "" Then
                'check in approvesrs1:
                mtch = Application.match(strUser, arrApp1, 0)
                If IsNumeric(mtch) Then  'if strReplace does not exist
                    If Not userExists(strReplace, CStr(arr(i, 3))) Then
                          arrApp1(mtch - 1) = strReplace  'it replaces strUser
                    Else                                   'only eliminates strUser
                          arrApp1(mtch - 1) = arrApp1(mtch - 1) & "#$@"
                          arrApp1 = Sort(arrApp1, arrApp1(mtch - 1) & "#$@", False)
                    End If
                    arr(i, 3) = Join(arrApp1, ",")
                End If
                'check in approvesrs2:
                mtch = Application.match(strUser, arrApp2, 0)
                If IsNumeric(mtch) Then  'if strReplace does not exist
                    If Not userExists(strReplace, CStr(arr(i, 4))) Then
                          arrApp2(mtch - 1) = strReplace  'it replaces strUser
                    Else                                   'only eliminates strUser
                          arrApp2(mtch - 1) = arrApp2(mtch - 1) & "#$@"
                          arrApp2 = Sort(arrApp2, arrApp2(mtch - 1) & "#$@", False)
                    End If
                    arr(i, 3) = Join(arrApp1, ",")
                End If
             ElseIf userPrezent <> "" Then
                'Appending only if a user name (userPrezent) exists:
                'check in approvesrs1:
                mtch = Application.match(userPrezent, arrApp1, 0)
                If IsNumeric(mtch) Then
                    If Not userExists(strUser, CStr(arr(i, 3))) Then
                        arr(i, 3) = arr(i, 3) & "," & strUser 'append it only if strUser does  not exist
                    End If
                End If
                'check in approvesrs2:
                mtch = Application.match(userPrezent, arrApp2, 0)
                If IsNumeric(mtch) Then
                    If Not userExists(strUser, CStr(arr(i, 4))) Then
                        arr(i, 4) = arr(i, 4) & "," & strUser 'append it only if strUser does  not exist
                    End If
                End If
            Else
                'appending without any condition
                If Not userExists(strUser, CStr(arr(i, 3))) Then
                    arr(i, 3) = arr(i, 3) & "," & strUser  'append it only if strUser does  not exist
                End If
                If Not userExists(strUser, CStr(arr(i, 4))) Then
                    arr(i, 4) = arr(i, 4) & "," & strUser 'append it only if strUser does  not exist
                End If
           End If
        End If
    Next i
    rngProc.Columns("D:G").Value2 = arr
End Sub

Function userExists(strUsers As String, strUser) As Boolean
    Dim arr() As String, mtch As Variant
    arr = Split(Replace(strUsers, " ", ""), ",")
    mtch = Application.match(strUser, arr, 0)
    userExists = IsNumeric(mtch)
End Function

The range to be processed should be placed in columns A:G.

The above code also checks if the user to be appended, or to replace an existing one already exists and add it only if it does not.

I made some tests using generic users, groups, as "user1", "user2" etc. and "group1", "group2" etc.

You may proceed in the same way (on a dummy workbook) or use your real user/group names and change them in the next testing sub:

Sub testUpdateUsers()
  Dim sh As Worksheet, lastR As Long, rngProc As Range
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row
  Set rngProc = sh.Range("A2:G" & lastR)
  
  updateUsers rngProc, "user9", "group4", "user10"    'replace "user10" with "user9", for "group4"
  Stop 'see the replacement and press F5
  
  updateUsers rngProc, "user9", "group4", , "user1"   'append "user10" in "group4" if "user1" alredy exists
  Stop 'see the replacement and press F5
  
  updateUsers rngProc, "user13", "group4"             'append "user10" in "group4"
End Sub