# key sheet based macro



## Tonyk1051 (Jan 6, 2023)

Hi,

Everyday i have to review changes made by several users and it takes around an hour to do.... in the keysheet attached is a list of categories my dept uses and the word "yes" means he/she is authorized to use that category. to the right is the name of every user and which dept they belong to. Example:some users belong to "warehouse" you'll see that the warehouse users are only allowed to use one or two categories anything else i will mark no in the actual spread sheet "user activity"

In the user activity spreadsheet, tab "category change detail"

the column that says "authorized" i put yes if the categories in column F follow the keysheet, if a cell in column F is blank then i leave it blank, if its a category that not marked yes in the keysheet then i put the word no

when all done i sort the entire spread sheet by column D and look for any duplicates. Any ID which is duplicate I color (light blue) the line that has an earlier date
so ID:7716899 appears twice, one has 5:30pm the other has 6:00pm , the one that is 5:30pm is colored . then i call it day.

hopefully someone can help me

key sheet.xlsx     keysheet

RTV User Activity 2023-01-06.xlsm     spreadsheet to apply macro


----------



## breynolds0431 (Jan 7, 2023)

See if the below works for you. The first sub, `validate()`, will populate the "Authorized?" column using the key sheet's data. The next sub, `DupCheck()`, will sort the "Category Changes Detail" tab by ID and then by time to then identify duplicates and shade the earliest time. Note that the DupCheck is called from the validate code. 


```
Sub validate()

'variables for this workbook and external workbook
Dim tWB As Workbook: Set tWB = ThisWorkbook
Dim tWS As Worksheet: Set tWS = tWB.Sheets("Category Changes Detail")
Dim xWB As Workbook: Set xWB = Workbooks("key sheet.xlsx")
Dim xWS As Worksheet: Set xWS = xWB.Sheets("Sheet1")

'variables for loop
Dim uID As Variant, cID As Integer, cat As Integer, c As Range
Dim lrow As Long: lrow = tWS.Cells(tWS.Rows.Count, 1).End(xlUp).Row
Dim ulRng As Range: Set ulRng = xWB.Sheets(1).Columns("M:N")

'loops through each row of tWS
For Each c In tWS.Range("A2:A" & lrow).Cells
    'As long as the category is not blank, then loop continues
    If Not tWS.Cells(c.Row, 6).Value = "" Then

        'gets group from username
        If IsError(Application.VLookup(c.Value, ulRng, 2, False)) Then
            uID = ""
        Else
            uID = Application.VLookup(c.Value, ulRng, 2, False)
        End If
        
        'finds column of group
        If IsError(Application.Match(uID, xWS.Rows(1), 0)) Then
            cID = 0
        Else
            cID = Application.Match(uID, xWS.Rows(1), 0)
        End If
        
        'finds row of category
        If IsError(Application.Match(tWS.Cells(c.Row, 6), xWS.Columns(1), 0)) Then
            cat = 0
        Else
            cat = Application.Match(tWS.Cells(c.Row, 6), xWS.Columns(1), 0)
        End If
        
        'if any above variables were in error, then Authorized? will equal "Error"
        If uID = "" Or cID = 0 Or cat = 0 Then
           tWS.Cells(c.Row, 7).Value = "Error"
        Else
            'if key sheet has a blank, then Authorized? = no
            If xWS.Cells(cat, cID).Value = "" Then
                tWS.Cells(c.Row, 7).Value = "no"
            Else
                'returns actual value found in key sheet
                tWS.Cells(c.Row, 7).Value = LCase(xWS.Cells(cat, cID).Value)
            End If
        End If
    End If
Next c

Call DupCheck

End Sub

Sub DupCheck()

'book and sheet variables
Dim tWB As Workbook: Set tWB = ThisWorkbook
Dim tWS As Worksheet: Set tWS = tWB.Sheets("Category Changes Detail")

'variables for sort
Dim lrow As Long: lrow = tWS.Cells(tWS.Rows.Count, 1).End(xlUp).Row
Dim rng1 As Range: Set rng1 = tWS.Range("D2:D" & lrow)
Dim rng2 As Range: Set rng2 = tWS.Range("C2:C" & lrow)

'sorts data
With tWS.Sort
    .SortFields.Clear
    .SortFields.Add2 Key _
        :=rng1, SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    .SortFields.Add2 Key _
        :=rng2, SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    .SetRange tWS.Range("A1:L" & lrow)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'duplicate evaluation
Dim c As Range

With tWS
    'loops through IDs to find duplicates
    For Each c In rng1.Cells
        If Not c.Row = 1 Then
            'since the data is sorted by ID and then by time, this should shade
            'the earliest time of the duplicate ID found
            If .Cells(c.Row, 4).Value = .Cells(c.Row + 1, 4).Value Then
                If Not .Cells(c.Row - 1, 4).Value = .Cells(c.Row, 4).Value Then
                    .Cells(c.Row, 3).Interior.ColorIndex = 37
                End If
            End If
        End If
    Next c
End With
End Sub
```

During my testing, the loop that I created found some variances in the original Authorized column. I'm providing those below. See the last two columns, where the above code completed column H. Column I identifies the variances from the original "Authorized?" to the code's "Authorized?".

RTV User Activity 2023-01-06.xlsmABCDFGHI1User IDDateTimeItem IDNew CategoryAuthorized?Authorized?test4tonykJan 5, 202311:14:42 AM6972234LSIyesnoFALSE5tonykJan 5, 20239:07:27 AM7325452LSIyesnoFALSE59matomecsJan 5, 202311:26:28 AM7795382ORDERED PARTErrorFALSE64sscelzaJan 5, 20231:12:24 PM7798152ORDERED PARTyesFALSE78sscelzaJan 5, 20232:38:40 PM7802357ORDERED PARTyesFALSE324tonykJan 5, 20235:16:31 PM7830256DENIED DEFECTyesnoFALSECategory Changes DetailCell FormulasRangeFormulaI4:I5,I59,I64,I78,I324I4=H4=G4Cells with Conditional FormattingCellConditionCell FormatStop If TrueD:DCell ValueduplicatestextNO


----------



## Tonyk1051 (Jan 7, 2023)

Hi Breynolds,

I really appreciate you helping me out, saved me a couple 100 bucks and my job
2 things happened when i ran the macro.
The link in the file i used to copy paste the macro is below. The dup works, correct duplicates were highlighted in blue  BUT the authorize column did not populate
i  tried changing the tabname to match the name you had in your code
here is the error i got, not sure if it helps but the amount of lines for this report usually varies from a couple 100 to a 1000

User Activity.xlsm   (file i used)


----------



## breynolds0431 (Jan 7, 2023)

Hi. Is the key sheet file open? If not, code could be added to open it and close it if needed. But it does need to be open based on the code I wrote. Also, the file extension is needed. The original file on dropbox was titled "key sheet.xlsx". That was the filename used in the xWB variable.


----------



## Tonyk1051 (Jan 7, 2023)

breynolds0431 said:


> Hi. Is the key sheet file open? If not, code could be added to open it and close it if needed. But it does need to be open based on the code I wrote. Also, the file extension is needed. The original file on dropbox was titled "key sheet.xlsx". That was the filename used in the xWB variable.


no it wasnt open but its much more preferred to use the file i just gave as the keysheet is the next tab over, that way when i pull the data all i have to do just copy the data to the macro file and run it


----------



## Alex Blakenburg (Jan 7, 2023)

Since you still seem to be online. For a quick and dirty modification, just point the xWB at the other workbook or remove that line and point the xWS at that workbook eg

```
' Either
Dim xWB As Workbook: Set xWB = *tWB           *' or ThisWorkbook
Dim xWS As Worksheet: Set xWS = xWB.Sheets("keysheet")

' OR
Dim xWB As Workbook: Set xWB = Workbooks("key sheet.xlsx")    ' Remove this
Dim xWS As Worksheet: Set xWS = *tWB*.Sheets("keysheet")           ' and change this
```


----------



## Tonyk1051 (Jan 7, 2023)

Alex Blakenburg said:


> Since you still seem to be online. For a quick and dirty modification, just point the xWB at the other workbook or remove that line and point the xWS at that workbook eg
> 
> ```
> ' Either
> ...


alright ill try that and let you know


----------



## Tonyk1051 (Jan 7, 2023)

Tonyk1051 said:


> alright ill try that and let you know


everything works as it should but with some very minor issues.. what happens when i have to add new employees ? can i just add them to the keysheet and just re run the macro?


----------



## Tonyk1051 (Jan 7, 2023)

breynolds0431 said:


> Hi. Is the key sheet file open? If not, code could be added to open it and close it if needed. But it does need to be open based on the code I wrote. Also, the file extension is needed. The original file on dropbox was titled "key sheet.xlsx". That was the filename used in the xWB variable.


it works thanks to you and alex, i just need to know how do i go about the process when i get new employees/users..


----------



## Alex Blakenburg (Sunday at 6:22 AM)

Tonyk1051 said:


> how do i go about the process when i get new employees/users..


The way breynolds0431 has written the code adding more user names in the user to group mapping table will work fine.
Adding more user "columns" however will move columns M:N which are hard coded in the code.

Change the line of code below and that should address the additional column issue.

```
' Replace the next line
'Dim ulRng As Range: Set ulRng = xWB.Sheets(1).Columns("M:N")
' With this line
Dim ulRng As Range: Set ulRng = xWS.Cells(1, Columns.Count).End(xlToLeft).CurrentRegion
```


----------



## Tonyk1051 (Jan 6, 2023)

Hi,

Everyday i have to review changes made by several users and it takes around an hour to do.... in the keysheet attached is a list of categories my dept uses and the word "yes" means he/she is authorized to use that category. to the right is the name of every user and which dept they belong to. Example:some users belong to "warehouse" you'll see that the warehouse users are only allowed to use one or two categories anything else i will mark no in the actual spread sheet "user activity"

In the user activity spreadsheet, tab "category change detail"

the column that says "authorized" i put yes if the categories in column F follow the keysheet, if a cell in column F is blank then i leave it blank, if its a category that not marked yes in the keysheet then i put the word no

when all done i sort the entire spread sheet by column D and look for any duplicates. Any ID which is duplicate I color (light blue) the line that has an earlier date
so ID:7716899 appears twice, one has 5:30pm the other has 6:00pm , the one that is 5:30pm is colored . then i call it day.

hopefully someone can help me

key sheet.xlsx     keysheet

RTV User Activity 2023-01-06.xlsm     spreadsheet to apply macro


----------



## Tonyk1051 (Monday at 7:12 AM)

Alex Blakenburg said:


> The way breynolds0431 has written the code adding more user names in the user to group mapping table will work fine.
> Adding more user "columns" however will move columns M:N which are hard coded in the code.
> 
> Change the line of code below and that should address the additional column issue.
> ...


Breynolds and Alex, thank you guys for the help. much appreciated


----------



## Alex Blakenburg (Monday at 7:37 AM)

Thanks for letting us know. Glad we could help.
Can I suggest that you mark breynolds post #2 as the solution, the other posts are only minor tweaks based on some slight changes to the requirements, and won't help others as much the post #2 will.


----------

