Macro is not removing Duplicates as expected

[christobalc]

This macro should remove duplicates but it is not doing so.. Any ideas?

Function SheetExists(SheetName As String) As Boolean
' returns TRUE if the sheet exists in the active workbook
    SheetExists = False
    On Error GoTo NoSuchSheet
    If Len(Sheets(SheetName).Name) > 0 Then
        SheetExists = True
    End If
NoSuchSheet:

End Function
Sub GetOutput()
    
' Add an output sheet
    Sheets("Sheet1").Select
    If Not SheetExists("Output") Then
        Sheets.Add.Name = "Output"
    End If
    Sheets("Output").Select
' Add Headers
    Cells(1, "A").Value = "id_customer"
    Cells(1, "B").Value = "appointment_date"
    Cells(1, "C").Value = "appointment_time"
    Cells(1, "D").Value = "first"
    Cells(1, "E").Value = "last"
    Cells(1, "F").Value = "phone1"
    Cells(1, "G").Value = "cellphone"
    Cells(1, "H").Value = "pay_type"
    Cells(1, "I").Value = "treatment_type"
' Format columns
    Columns("C:C").Select
    
    Selection.NumberFormat = "hh:mm:ss" '"[$-F400]h:mm:ss AM/PM"

' Get the Date
    Sheets("Sheet1").Select
    Rownum = 3
    Offset = 3
    While Cells(Rownum, "A").Value = ""
        Rownum = Rownum + 1
    Wend
    lastRow = Rownum - 1
    nd = Len(Cells(Rownum, "A").Value) + 1
    bg = InStr(Cells(Rownum, "A").Value, "for") + 4
    Appointmentdate = Mid(Cells(Rownum, "A"), bg, nd - bg)
' For all appointments
    For Rownum = 5 To lastRow
    Sheets("Sheet1").Select
    'skip duplicates
    If Cells(Rownum, "C").Value > " " Then
        apttime = Cells(Rownum, "C").Value
    End If
        If Cells(Rownum, "D").Value <> Cells(Rownum - 1, "D") Then
     'get the time if its changed... if not then its the previous lines time
             If Cells(Rownum, "D").Value > " " Then
 
                 bg = 1
                 nd = InStr(Cells(Rownum, "D").Value, ",")
                 lastname = Mid(Cells(Rownum, "D").Value, bg, nd - bg)
                 bg = nd + 1
                 nd = InStr(Cells(Rownum, "D").Value, "[")
                 firstname = Mid(Cells(Rownum, "D").Value, bg, nd - bg)
                 bg = nd + 1
                 nd = Len(Cells(Rownum, "D").Value)
                 custid = Mid(Cells(Rownum, "D").Value, bg, nd - bg)
                'fill values
                 Sheets("Output").Cells(Rownum - Offset, "A").Value = custid
                 Sheets("Output").Cells(Rownum - Offset, "B").Value = Appointmentdate
                 Sheets("Output").Cells(Rownum - Offset, "C").Value = apttime
                 Sheets("Output").Cells(Rownum - Offset, "D").Value = firstname
                 Sheets("Output").Cells(Rownum - Offset, "E").Value = lastname
                 Sheets("Output").Cells(Rownum - Offset, "F").Value = Sheets("Sheet1").Cells(Rownum, "E").Value
                 cellphone = Replace(Sheets("Sheet1").Cells(Rownum, "F").Value, "-", "")
                 cellphone = "1" & cellphone
                 cellphone = Replace(cellphone, "(", "")
                 cellphone = Replace(cellphone, ")", "")
                 cellphone = Replace(cellphone, " ", "")
                 If cellphone <> "1" Then Sheets("Output").Cells(Rownum - Offset, "G").Value = cellphone
                 Sheets("Output").Cells(Rownum - Offset, "H").Value = Sheets("Sheet1").Cells(Rownum, "H").Value
                 Sheets("Output").Cells(Rownum - Offset, "I").Value = Sheets("Sheet1").Cells(Rownum, "I").Value
            Else:
                Offset = Offset + 1
            End If
                
        Else:
                Offset = Offset + 1
        End If
' Next appointment until lastrow
     Next Rownum
     
    
' Save the active sheet as output file
    Sheets("Output").Select
'    Dim i As Long, fname As Variant
'    ActiveSheet.Copy
    'Do
    '    fname = Application.GetSaveAsFilename
    'Loop Until fname <> False
'    ActiveWorkbook.SaveAs Filename:="output.csv", FileFormat:=xlCSV
'    Workbooks(Workbooks.Count).Close
    
'Delete output sheet
'    Application.DisplayAlerts = False
'    Sheets("Output").Delete
'    Application.DisplayAlerts = True

End Sub

[JBeaucaire]

Post a small sample workbook with the raw data, tell us exactly what you're evaluating, and perhaps a sample "output" file you expect as a result of the small sample data set.

[christobalc]

Here are the before and after files. id_customer 2007 in column A , second record is not removed with the current macro and should be.

The newest-original file is the macro file.

[Leith Ross]

Hello christobalc,

For the macro to work, you must first sort the data in ascending order using column "D".

[christobalc]

Can you pl
ease post the correct code

[watersev]

see attachment, run macro "test"