Need help deleting corresponding rows on one sheet based on values from another sheet

[Jeremy4110]

I pull/extract supplier (name, address, numbers, etc) information from our system then I update and consolidate duplicate records. I set suppliers to inactive for only two reasons: 1.) There have been any sales in the last five years. 2.) They are a duplicate. The duplicates are reassigned to an active location. I have to track all the changes that I make. The extracted are pulled to a sheet called "Sup Loc Original" then copied to "Sup Loc Copy". I make changes and reassign duplicate records on the copy then upload the changes. Lastly I compare and track the changes made on a third sheet called "Dats Point" with the code below.

Here is my problem, I can only track the changes to every field and I need to be able track the changed information for inactive records and reassigned records as well. The code below isn't my creation, I altered it a little. What I would like to be able to do is delete the corresponding rows on the "Data Points" sheet that are active on the "Sup Loc Copy" sheet. The rows are identified with an "A" in column X. That way I can rerun the code to count and sum the information for the inactive locations. So basically if rows 2, 5, 7 and 8 are active on the "Sup Loc Copy" sheet then I need to delete those same rows on the "Data Points" sheet and I have no idea how to do that. I have looked for code that I could try to alter but have been unsuccessfully. Any help would be greatly appreciated.





Sub Data_Points_Compare2WorkSheets()


Sheets("Sup Loc COPY").Select
Sheets("Sup Loc COPY").Name = "Sup Loc COPY"
Cells.Select
ActiveWorkbook.Worksheets("Sup Loc COPY").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sup Loc COPY").Sort.SortFields.Add Key:=Range( _
"A2:A10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sup Loc COPY").Sort
.SetRange Range("A1:AZ10000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sup Loc ORIGINAL").Select
Cells.Select
ActiveWorkbook.Worksheets("Sup Loc ORIGINAL").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sup Loc ORIGINAL").Sort.SortFields.Add Key:=Range( _
"A2:A10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sup Loc ORIGINAL").Sort
.SetRange Range("A1:AZ10000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Sheets("Sheet3").Select
Sheets("Sheet3").Name = "Data Points"
Sheets("Data Points").Select
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets("Sup Loc ORIGINAL")
Set ws2 = Sheets("Sup Loc COPY")

Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String
Dim difference As Integer
Dim row As Long, col As Integer

With ws1.UsedRange
ws1row = .Rows.Count
ws1col = .Columns.Count
End With

With ws2.UsedRange
ws2row = .Rows.Count
ws2col = .Columns.Count
End With

maxrow = ws1row
maxcol = ws1col

If maxrow < ws2row Then maxrow = ws2row
If maxcol < ws2col Then maxcol = ws2col
difference = 0
For col = 1 To maxcol
For row = 1 To maxrow

colval1 = ""
colval2 = ""
colval1 = ws1.Cells(row, col).Formula
colval2 = ws2.Cells(row, col).Formula

If colval1 <> colval2 Then
difference = difference + 1
Cells(row, col).Formula = colval1 & " <> " & colval2
Cells(row, col).Interior.Color = 255
Cells(row, col).Font.ColorIndex = 2
Cells(row, col).Font.Bold = True
End If
Next row
Next col

Range("BA1:CP1").Value = "=COUNTA(R[1]C[-52]:R[10000]C[-52])"
Range("CQ1").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-42]:RC[-22],RC[-20]:RC[-7],RC[-4]:RC[-1])"
Range("BA1:CQ1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False


End Sub

 

[Jeremy4110]

I haven't had any replies but I have worked out a solution to my problem. I sorted the two sheets that I wanted to compare then copied the data from the "after" sheet to the "data points" after the comparison was made then deleted the rows based on the criteria that I wanted. Below is the code it used.

Sub Sup_Loc_Data_Points()
'
'NEW 07-20-16

If WorksheetExists("Data Points") Then
MSG1 = MsgBox("A (Data Points) sheets exists, do you want to continue?", vbYesNo)

If MSG1 = vbYes Then
'Dim Dt As String
'Dim Response As Integer
'Dt = " - " & Format(Now, "mm-dd-yy") 'hh-mm-ss")
Dim Ct As String
Ct = "-" & Worksheets.Count
Sheets("Data Points").Select
ActiveSheet.Name = "Data Points" & Ct
Worksheets.Add(After:=Worksheets(12)).Name = "Sheet3"
Else
Sheets("Sup Loc COPY").Select
Range("A1").Select
Exit Sub
End If

End If

Sheets("Sup Loc COPY").Select
Cells.Select
ActiveWorkbook.Worksheets("Sup Loc COPY").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sup Loc COPY").Sort.SortFields.Add Key:=Range( _
"A2:A10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sup Loc COPY").Sort
.SetRange Range("A1:AZ10000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Sheets("Sup Loc ORIGINAL").Select
Cells.Select
ActiveWorkbook.Worksheets("Sup Loc ORIGINAL").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sup Loc ORIGINAL").Sort.SortFields.Add Key:=Range( _
"A2:A10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sup Loc ORIGINAL").Sort
.SetRange Range("A1:AZ10000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select

If Not WorksheetExists("Sheet3") Then
Sheets.Add After:=Sheets(10)
ActiveSheet.Name = "Sheet3"
Else
End If

Sheets("Sheet3").Select
Sheets("Sheet3").Name = "Data Points"
'Sheets("Data Points").Select
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets("Sup Loc ORIGINAL")
Set ws2 = Sheets("Sup Loc COPY")

Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String
Dim difference As Integer
Dim row As Long, col As Integer

With ws1.UsedRange
ws1row = .Rows.Count
ws1col = .Columns.Count
End With

With ws2.UsedRange
ws2row = .Rows.Count
ws2col = .Columns.Count
End With

maxrow = ws1row
maxcol = ws1col

If maxrow < ws2row Then maxrow = ws2row
If maxcol < ws2col Then maxcol = ws2col
difference = 0
For col = 1 To maxcol
For row = 2 To maxrow
'For row = 1 To maxrow

colval1 = ""
colval2 = ""
colval1 = ws1.Cells(row, col).Formula
colval2 = ws2.Cells(row, col).Formula

If colval1 <> colval2 Then
difference = difference + 1
Cells(row, col).Formula = colval1 & " <> " & colval2
Cells(row, col).Interior.Color = 255
Cells(row, col).Font.ColorIndex = 2
Cells(row, col).Font.Bold = True
End If
Next row
Next col

'This is for if "Data Points" are ran again
If maxcol = 57 Then
Columns("AQ:BF").Delete Shift:=xlToLeft
Else
End If

Range("AZ1").Value = "='Sup Loc COPY'!R2C3"
Range("BA1:CP1").Value = "=COUNTA(R[1]C[-52]:R[10000]C[-52])"
Range("CQ1").Value = "=SUM(RC[-42]:RC[-22],RC[-20]:RC[-7],RC[-4]:RC[-1])"
Range("AZ1:CQ1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Sheets("Sup Loc COPY").Select
Range("D:D,X:X").Select
Selection.Copy
Range("A1").Select
Sheets("Data Points").Select
Columns("AS:AS").Select
ActiveSheet.Paste

Sheets("Data Points").Copy After:=Sheets(Sheets.Count)
'Sheets("Data Points").Copy Before:=Sheets(10)
ActiveSheet.Name = "Inactive Data Points"

Range("AQ2").Select
For i = 2 To maxrow
ActiveCell.FormulaR1C1 = "=IF(RC46 = ""A"", ""DELETE"","""")"
ActiveCell.Offset(1, 0).Select
Next i

'This starts the code to delete all rows where the value is "N" in Column G
Dim X As Long
For X = Cells(Rows.Count, 43).End(xlUp).row To 2 Step -1
If Cells(X, 43) = "DELETE" Then
Rows(X).EntireRow.Delete
End If
Next X
'End If

Range("BA2:CP2").Value = "=COUNTA(RC[-52]:R[10000]C[-52])"
Range("CR1").Value = "=SUM(R[1]C[-43]:R[1]C[-23],R[1]C[-21]:R[1]C[-8],R[1]C[-5]:R[1]C[-2])"
Range("BA1:CR2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("AQ2").Select
For i = 2 To maxrow
ActiveCell.FormulaR1C1 = "=IF(RC45 = """", ""DELETE"","""")"
ActiveCell.Offset(1, 0).Select
Next i

'This starts the code to delete all rows where the value is "N" in Column G
Dim y As Long
For y = Cells(Rows.Count, 43).End(xlUp).row To 2 Step -1
If Cells(y, 43) = "DELETE" Then
Rows.EntireRow.Delete
End If
Next y

Range("BA2:CP2").Value = "=COUNTA(RC[-52]:R[10000]C[-52])"
Range("CS1").Value = "=SUM(R[1]C[-44]:R[1]C[-24],R[1]C[-22]:R[1]C[-9],R[1]C[-6]:R[1]C[-3])"
Range("BA1:CS2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("CR1:CS1").Copy
Sheets("Data Points").Select
Range("CR1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AZ1:CS1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Application.DisplayAlerts = False
Sheets("Inactive Data Points").Delete
Application.DisplayAlerts = True

Columns("AS:AT").Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Font.Bold = True
Range("A1:AP1,AX1:CS1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With

Range("BV1,CK1:CL1").Select
Range("CK1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Range("CR2").Value = "='Sup Loc COPY'!R2C38"
Range("CS2").Value = "='Sup Loc Alias Data Points'!R2C41"
Range("AX2:CS2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("A1:AP1").Value = Array("LocationNo", "MFGID", "Supplier Name", "Reassigned", "ADD1", "ADD2", _
"ADD3 - Notes", "City", "State", "Zip", "Zip4", "Country", "Lan", "Phone1", "Phone2", "Fax", "CA-US $", _
"MX-US $", "Website - Notes", "Email - Notes", "Attention", "A/P No", "VFP", "A-I", "Sup Con", "FAX Cap", _
"EDI Cap", "BR Emit", "DC Emit", "BR-FM", "DC-FM", "MBEC", "MB", "HQ", "No-SupS", "SIM", "Last Update", _
"Review Date", "Review By", "No PO $", "Min PO $", "GPC")

Range("AX1:CS1").Value = Array("Supplier Name", "LocationNo", "MFGID", "Supplier Name", "Reassigned", "ADD1", "ADD2", _
"ADD3 - Notes", "City", "State", "Zip", "Zip4", "Country", "Lan", "Phone1", "Phone2", "Fax", "CA-US $", _
"MX-US $", "Website - Notes", "Email - Notes", "Attention", "A/P No", "VFP", "A-I", "Sup Con", "FAX Cap", _
"EDI Cap", "BR Emit", "DC Emit", "BR-FM", "DC-FM", "MBEC", "MB", "HQ", "No-SupS", "SIM", "Last Update", _
"Review Date", "Review By", "No PO $", "Min PO $", "GPC", "TDPC Sum", "IDPC Sum", "RDPC Sum", "Date", "Alias DP")

Set ws1 = Nothing
Set ws2 = Nothing
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Application.CutCopyMode = False

End Sub

 

[Jeremy4110]

Sub Sup_Loc_Data_Points()
'
'NEW 07-20-16

    If WorksheetExists("Data Points") Then
        MSG1 = MsgBox("A (Data Points) sheets exists, do you want to continue?", vbYesNo)

        If MSG1 = vbYes Then
            'Dim Dt As String
            'Dim Response As Integer
            'Dt = " - " & Format(Now, "mm-dd-yy") 'hh-mm-ss")
            Dim Ct As String
            Ct = "-" & Worksheets.Count
            Sheets("Data Points").Select
            ActiveSheet.Name = "Data Points" & Ct
            Worksheets.Add(After:=Worksheets(12)).Name = "Sheet3"
        Else
            Sheets("Sup Loc COPY").Select
            Range("A1").Select
            Exit Sub
        End If
    
    End If
   
    Sheets("Sup Loc COPY").Select
    Cells.Select
    ActiveWorkbook.Worksheets("Sup Loc COPY").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sup Loc COPY").Sort.SortFields.Add Key:=Range( _
        "A2:A10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sup Loc COPY").Sort
        .SetRange Range("A1:AZ10000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Sheets("Sup Loc ORIGINAL").Select
    Cells.Select
    ActiveWorkbook.Worksheets("Sup Loc ORIGINAL").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sup Loc ORIGINAL").Sort.SortFields.Add Key:=Range( _
        "A2:A10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sup Loc ORIGINAL").Sort
        .SetRange Range("A1:AZ10000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    
    If Not WorksheetExists("Sheet3") Then
    Sheets.Add After:=Sheets(10)
    ActiveSheet.Name = "Sheet3"
    Else
    End If
    
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "Data Points"
    'Sheets("Data Points").Select
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Sheets("Sup Loc ORIGINAL")
    Set ws2 = Sheets("Sup Loc COPY")

    Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
    Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String
    Dim difference As Integer
    Dim row As Long, col As Integer
    
    With ws1.UsedRange
    ws1row = .Rows.Count
    ws1col = .Columns.Count
    End With
    
    With ws2.UsedRange
    ws2row = .Rows.Count
    ws2col = .Columns.Count
    End With
    
    maxrow = ws1row
    maxcol = ws1col
    
    If maxrow < ws2row Then maxrow = ws2row
    If maxcol < ws2col Then maxcol = ws2col
    difference = 0
    For col = 1 To maxcol
    For row = 2 To maxrow
    'For row = 1 To maxrow
    
    colval1 = ""
    colval2 = ""
    colval1 = ws1.Cells(row, col).Formula
    colval2 = ws2.Cells(row, col).Formula
 
    If colval1 <> colval2 Then
    difference = difference + 1
    Cells(row, col).Formula = colval1 & " <> " & colval2
    Cells(row, col).Interior.Color = 255
    Cells(row, col).Font.ColorIndex = 2
    Cells(row, col).Font.Bold = True
    End If
    Next row
    Next col
    
    'This is for if "Data Points" are ran again
    If maxcol = 57 Then
    Columns("AQ:BF").Delete Shift:=xlToLeft
    Else
    End If
    
    Range("AZ1").Value = "='Sup Loc COPY'!R2C3"
    Range("BA1:CP1").Value = "=COUNTA(R[1]C[-52]:R[10000]C[-52])"
    Range("CQ1").Value = "=SUM(RC[-42]:RC[-22],RC[-20]:RC[-7],RC[-4]:RC[-1])"
    Range("AZ1:CQ1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    Sheets("Sup Loc COPY").Select
    Range("D:D,X:X").Select
    Selection.Copy
    Range("A1").Select
    Sheets("Data Points").Select
    Columns("AS:AS").Select
    ActiveSheet.Paste

    Sheets("Data Points").Copy After:=Sheets(Sheets.Count)
    'Sheets("Data Points").Copy Before:=Sheets(10)
    ActiveSheet.Name = "Inactive Data Points"
    
    Range("AQ2").Select
    For i = 2 To maxrow
    ActiveCell.FormulaR1C1 = "=IF(RC46 = ""A"", ""DELETE"","""")"
    ActiveCell.Offset(1, 0).Select
    Next i
    
    'This starts the code to delete all rows where the value is "N" in Column G
    Dim X As Long
        For X = Cells(Rows.Count, 43).End(xlUp).row To 2 Step -1
           If Cells(X, 43) = "DELETE" Then
           Rows(X).EntireRow.Delete
           End If
        Next X
    'End If
   
    Range("BA2:CP2").Value = "=COUNTA(RC[-52]:R[10000]C[-52])"
    Range("CR1").Value = "=SUM(R[1]C[-43]:R[1]C[-23],R[1]C[-21]:R[1]C[-8],R[1]C[-5]:R[1]C[-2])"
    Range("BA1:CR2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   
    Range("AQ2").Select
    For i = 2 To maxrow
    ActiveCell.FormulaR1C1 = "=IF(RC45 = """", ""DELETE"","""")"
    ActiveCell.Offset(1, 0).Select
    Next i
    
   'This starts the code to delete all rows where the value is "N" in Column G
    Dim y As Long
        For y = Cells(Rows.Count, 43).End(xlUp).row To 2 Step -1
            If Cells(y, 43) = "DELETE" Then
            Rows(y).EntireRow.Delete
            End If
        Next y
   
    Range("BA2:CP2").Value = "=COUNTA(RC[-52]:R[10000]C[-52])"
    Range("CS1").Value = "=SUM(R[1]C[-44]:R[1]C[-24],R[1]C[-22]:R[1]C[-9],R[1]C[-6]:R[1]C[-3])"
    Range("BA1:CS2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   
    Range("CR1:CS1").Copy
    Sheets("Data Points").Select
    Range("CR1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AZ1:CS1").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
    Application.DisplayAlerts = False
    Sheets("Inactive Data Points").Delete
    Application.DisplayAlerts = True
        
    Columns("AS:AT").Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Font.Bold = True
    Range("A1:AP1,AX1:CS1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With

    Range("BV1,CK1:CL1").Select
    Range("CK1").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    Range("CR2").Value = "='Sup Loc COPY'!R2C38"
    Range("CS2").Value = "='Sup Loc Alias Data Points'!R2C41"
    Range("AX2:CS2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   
    Range("A1:AP1").Value = Array("LocationNo", "MFGID", "Supplier Name", "Reassigned", "ADD1", "ADD2", _
    "ADD3 - Notes", "City", "State", "Zip", "Zip4", "Country", "Lan", "Phone1", "Phone2", "Fax", "CA-US $", _
    "MX-US $", "Website - Notes", "Email - Notes", "Attention", "A/P No", "VFP", "A-I", "Sup Con", "FAX Cap", _
    "EDI Cap", "BR Emit", "DC Emit", "BR-FM", "DC-FM", "MBEC", "MB", "HQ", "No-SupS", "SIM", "Last Update", _
    "Review Date", "Review By", "No PO $", "Min PO $", "GPC")

    Range("AX1:CS1").Value = Array("Supplier Name", "LocationNo", "MFGID", "Supplier Name", "Reassigned", "ADD1", "ADD2", _
    "ADD3 - Notes", "City", "State", "Zip", "Zip4", "Country", "Lan", "Phone1", "Phone2", "Fax", "CA-US $", _
    "MX-US $", "Website - Notes", "Email - Notes", "Attention", "A/P No", "VFP", "A-I", "Sup Con", "FAX Cap", _
    "EDI Cap", "BR Emit", "DC Emit", "BR-FM", "DC-FM", "MBEC", "MB", "HQ", "No-SupS", "SIM", "Last Update", _
    "Review Date", "Review By", "No PO $", "Min PO $", "GPC", "TDPC Sum", "IDPC Sum", "RDPC Sum", "Date", "Alias DP")
    
    Set ws1 = Nothing
    Set ws2 = Nothing
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Application.CutCopyMode = False
   
End Sub