Need to display only unique employee name in summary - need some corrections in below code

Hi team,

Need small alteration with below code (Attached macro file for your reference).
In details sheet I have employee “John” listed twice who is working under location “ARZN”. On clicking submit button in attached file, I need to have John displayed only once with qty as “187”.

Please advise.

Option Explicit

Sub Extract_Stuff()
  Dim ws As Worksheet, ws1 As Worksheet
  Dim cel As Range
  Dim LR As Long, LR1 As Long, LC As Long, x As Long

  Set ws = Sheets("Details")
  Set ws1 = Sheets("Summary")

  Application.ScreenUpdating = False
  With ws1
    LR1 = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious).Row
    If LR1 > 6 Then
      .Range("A7:F" & LR1).Cells.Clear
    End If
  End With

  If Not Evaluate("ISREF(Lists!A1)") Then
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Lists"
  Else
    Sheets("Lists").Cells.ClearContents
  End If
  With ws

    LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                     SearchDirection:=xlPrevious).Row
    LC = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
                     SearchDirection:=xlPrevious).Column

    .Columns("B:B").AdvancedFilter Action:=xlFilterCopy, _
                                   CopyToRange:=Sheets("Lists").Range("A1"), Unique:=True
    ActiveWorkbook.Names.Add Name:="Location", RefersTo:= _
                             "=OFFSET(Lists!$A$2,0,0,(COUNTA(Lists!$A:$A)-1),1)"
    If Not .AutoFilterMode Then
      .Rows("1:1").AutoFilter
    End If

    For Each cel In Sheets("Lists").Range("Location")
      .Range(.Cells(1, 1), .Cells(LR, LC)).AutoFilter Field:=2, Criteria1:=cel.Value
      With .AutoFilter.Range
        x = .Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
      End With

      .Range(.Cells(2, "C"), .Cells(LR, "D")).SpecialCells(xlCellTypeVisible).Copy

      With ws1
        LR1 = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
        .Cells(LR1 + 1, "A").Value = cel.Value
        .Cells(LR1 + 1, "B").PasteSpecial

        .Cells(LR1 + 1, "A").Resize(x, 1).Merge
        .Cells(LR1 + 1, "A").VerticalAlignment = xlCenter
        .Cells(LR1 + 1, "A").HorizontalAlignment = xlCenter
        Application.CutCopyMode = False
      End With
    Next cel
    .AutoFilterMode = False

  End With
  Application.DisplayAlerts = False
  Sheets("Lists").Delete
  Application.DisplayAlerts = True
  ws1.Activate
  Application.ScreenUpdating = True
End Sub

add this macro to your code:

Sub Macro1()
Sheets("Details").Select
Dim LR As Integer


LR = Range("A65536").End(xlUp).Row

'    Range("A1:D" & LR).Select
    ActiveWorkbook.Worksheets("Details").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Details").Sort.SortFields.Add Key:=Range("C2:C" & LR) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Details").Sort.SortFields.Add Key:=Range("B2:B" & LR) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Details").Sort
        .SetRange Range("A1:D" & LR)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Range("E2:E" & LR).FormulaR1C1 = "=IF(AND(RC[-3]=R[-1]C[-3],RC[-2]=R[-1]C[-2]),1,0)"

    Range("F2:F" & LR).FormulaR1C1 = "=IF(RC[-1]=0,RC[-2],RC[-2]+R[-1]C)"
    
    Range("G2:G" & LR).FormulaR1C1 = "=IF(AND(RC[-5]=R[1]C[-5],RC[-4]=R[1]C[-4]),0,1)"
    
   Range("A1:G" & LR).Value = Range("A1:G" & LR).Value
        
    Range("A1:G" & LR).Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Details").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Details").Sort.SortFields.Add Key:=Range("G2:G" & LR), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Details").Sort
        .SetRange Range("A1:G" & LR)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Columns("G:G").Select
    Selection.Find(What:="0", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate

    Rows(ActiveCell.Row & ":" & LR).Select
    Selection.Delete Shift:=xlUp
    Columns("E:G").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    
End Sub

Hi,
Thanks for the code, but your code removes the duplicate names from details sheet which is not the thing I'm expecting. What I need is , if same employee is working under two different locations, then it should display the employee name twice, similarly if under same location employee is listed twice then it should sum the qty and display the name only once,

Hi,
Thanks for the code, but your code removes the duplicate names from details sheet which is not the thing I'm expecting. What I need is , if same employee is working under two different locations, then it should display the employee name twice, similarly if under same location employee is listed twice then it should sum the qty and display the name only once,