Link to home
Start Free TrialLog in
Avatar of gdunn59
gdunn59

asked on

Need to find the last row in my spreadsheet that contains data and use that in my Range.

I have this vba code in my excel spreadsheet that specifies a range.  

Instead of hardcoding the end range, I want to have it automatically find the very last row of data and select that as the end range.


Here is my line of code that I currently have:

ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$2:$AY$7370"), , xlYes).Name = "Pivot_Table"
Set DataTable = ActiveSheet.ListObjects("Pivot_Table")

Open in new window



So instead of $AY$7370, I want it to automatically determine what the very last row is that contains data.


Thank you!

Avatar of Martin Liss
Martin Liss
Flag of United States of America image

ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$2:$AY$"&Activesheet.ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$2:$AY$7370"), , xlYes).Name = "Pivot_Table"
Set DataTable = ActiveSheet.ListObjects("Pivot_Table")), , xlYes).Name = "Pivot_Table"

Open in new window

Avatar of gdunn59
gdunn59

ASKER

Martin Liss:

I tried your solution, but I am getting the following error on the first line of code:

Expected: list separator or )

Also getting the following error on the second line of code:

Expected: end of statement

The rows may go beyond the $AY$7370, that's why I need it to find the last row that contains data.

Thanks!
I apologize for not testing my previous solution.

Sub CreateDataTable()
Dim lngLastrow As Long
Dim DataTable As ListObject

With ActiveSheet
    lngLastrow = .Range("AY1048576").End(xlUp).Row
    .ListObjects.Add(xlSrcRange, Range("$B$2:$AY$" & lngLastrow), , xlYes).Name = "Pivot_Table"
    Set DataTable = .ListObjects("Pivot_Table")
End With
End Sub

Open in new window

Avatar of gdunn59

ASKER

Martin Liss:

Something still is not working correctly.

Now it is putting Column headings (ie. Column1, Column2, etc.) at the very top where these is currently a blank row.

Thanks!
Avatar of gdunn59

ASKER

Martin Liss:

I thought it be best if I share the entire snippet of code:

Sub Cleanup_Data()

' check if Dups_Removed sheet exists if so Delete it
    Dim xWs As Worksheet
    Dim sheetName As String
    sheetName = "Dups_Removed"
    
    Application.DisplayAlerts = False
    Err.Clear
    On Error Resume Next
    
    Set xWs = Sheets(sheetName)
        xWs.Delete
       
    Application.DisplayAlerts = True

' create copy of data (data contains dups - will remove the dups later in the code)
    Sheets("Data_With_Dups").Copy After:=Sheets("Data_With_Dups")
    Sheets("Data_With_Dups (2)").Name = "Dups_Removed"
    
'    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
'    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$2:$AY$7370"), , xlYes).Name _
'        = "Pivot_Table"
'    Set DataTable = ActiveSheet.ListObjects("Pivot_Table")
    
    
    
'EE
Dim lngLastrow As Long
Dim DataTable As ListObject

With ActiveSheet
    lngLastrow = .Range("AY1048576").End(xlUp).Row
    .ListObjects.Add(xlSrcRange, Range("$B$2:$AY$" & lngLastrow), , xlYes).Name = "Pivot_Table"
    Set DataTable = .ListObjects("Pivot_Table")
End With

    
' add new column for IDE_COMPLETE as Column 2
    DataTable.ListColumns.Add(2).Name = "IDE_COMPLETE"
    
' add new column for PME_COMPLETE as Column 3
    DataTable.ListColumns.Add(3).Name = "PME_COMPLETE"

' Populate PME_Complete column with "yes" or "no" based off of if PME_Program is "IDE"
    Range("Pivot_Table[[#Headers],[PME_COMPLETE]]").Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=IF([@[PME_PROGRAM]]=""IDE"",""YES"",""NO"")"
    
    Range("B2").AutoFilter
    

' sorts the PME_Complete column
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[PME_COMPLETE]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
' sorts the OPR.Close_Date column
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[MAX(OPR.CLOSE_DATE)]]"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
' sort the "blank" column that contains SSNs
'    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
'        SortFields.Add Key:=Range("Pivot_Table[[#All],[blank]]"), _
'        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
'    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
'        .Header = xlYes
'        .MatchCase = False
'        .Orientation = xlTopToBottom
'        .SortMethod = xlPinYin
'        .Apply
'    End With
   
' remove duplicates based off of Column 40 which is called "blank" and contains SSNs
    ActiveSheet.Range("Pivot_Table[#ALL]").RemoveDuplicates Columns:=40, Header _
        :=xlYes
        
' add new column for IS_COMMANDER as column 4
    DataTable.ListColumns.Add(4).Name = "IS_COMMANDER"
    Range("Pivot_Table[[#Headers],[IS_COMMANDER]]").Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=IF(LEFT([@[DAFSC_CURR]])=""C"",1,0)"
    
' add new column for Is_Selected as column 5
    DataTable.ListColumns.Add(5).Name = "IS_SELECTED"
    Range("Pivot_Table[[#Headers],[IS_SELECTED]]").Offset(1, 0).Select
    
' populate Is_Selected column with a 1 or 0 based off of if Sel_Stat field is an "S"
    ActiveCell.FormulaR1C1 = "=IF([@[SEL_STAT]]=""S"",1,0)"
    
' add new column Not_Selected as column 6
    DataTable.ListColumns.Add(6).Name = "NOT_SELECTED"
    Range("Pivot_Table[[#Headers],[NOT_SELECTED]]").Offset(1, 0).Select
    
' populate Not_Selected column with a 0 or 1
    ActiveCell.FormulaR1C1 = "=IF([@[SEL_STAT]]=""S"",0,1)"
            
' select Dups_Removed sheet and change tab color
    Sheets("Dups_Removed").Select
    With ActiveWorkbook.Sheets("Dups_Removed").Tab
'        .Color = 49407
        .Color = 49990
        .TintAndShade = 0
    End With

' delete blank Column A and blank Row 1
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

Rows("1:1").Select
Selection.Delete Shift:=xlUp
      
End Sub


Open in new window


Avatar of gdunn59

ASKER

Martin Liss:

Is putting all these columns on the very first row, which is blank.  I have code that later deletes that blank row.

 
Column1IDE_COMPLETEPME_COMPLETEIS_COMMANDERIS_SELECTEDNOT_SELECTEDColumn2Column3Column4Column5Column6Column7Column8Column9Column10Column11Column12Column13Column14Column15Column16Column17Column18Column19Column20Column21Column22Column23Column24Column25Column26Column27Column28Column29Column30Column31Column32Column33Column34Column35Column36Column37Column38Column39Column40Column41Column42Column43Column44Column45Column46Column47Column48Column49Column50

It should be putting the newly added columns from the code on Row A2.
I'm not sure I understand but I don't believe you can add a table that doesn't have headers. The headers however can be hidden by using the Style parameters for the table. If the headers get in the way then start the table one row further down.
Avatar of gdunn59

ASKER

Martin Liss:

There are headers.  They start on row 2.
Avatar of gdunn59

ASKER

Martin Liss:

The code was working properly and adding the new columns until I added the code you provided for the Range.

Thanks!
I'm sorry but I don't know what else I can do. If my suggestion doesn't work then please ignore it.
Avatar of gdunn59

ASKER

Martin Liss:

I apologize, I am not sure what caused it to start putting the headers on the 1st row, when before the code you provided it was placing the new added headers on the 2nd row.

Everything was okay with my code other than I need a way for it to select the range for the Table for however many rows it finds.  Currently there is only 7370 rows, but other times there may be more rows or less rows.

Does this make more sense??

Thanks!
ActiveSheet.ListObjects("Pivot_Table").DataBodyRange.Select
Avatar of gdunn59

ASKER

 Martin Liss:

Where do I insert that code you just posted?

Thank you!
At any point after the table is created. Would it be possible for you to attach a sample workbook that contains your current table-creation code.
Avatar of gdunn59

ASKER

Martin Liss:

I cannot upload a sample workbook because it contains PII data.

Thank you!
Avatar of gdunn59

ASKER

Martin Liss:

The Range is what creates the Table, correct??

If you are referring to my code in this post of mine then no. It can only be used after the table is created and it selects the data in the table which I assume is what you are after.

Couldn't you overwrite sensitive data in the sample workbook with garbage?
Avatar of gdunn59

ASKER

Martin Liss:

I'll have to see about changing the data and uploading.

Probably won't be until tomorrow.

Thanks
Avatar of gdunn59

ASKER

Martin Liss:

Here is my spreadsheet with fewer rows than the original which had 7370 rows, and also with dummy data.

If you look at the 2nd Tab (Dups_Removed) you can see what the results are with the Headers on Row 1 and the new column headers added.  But these headers should be on Row 2.

I have commented out my code that was working (other than I need to have it automatically determine the last row), and your code is not commented out.

Thanks for your assistance.

PBO Stats_TEMPLATE_EE.xlsm
Avatar of gdunn59

ASKER

Martin Liss:

Since it is working for you, can you send me the workbook with the final results of the 2nd Tab so I can see it.

I am using Excel 2016.

Thanks!
I just deleted a comment that  I accidentally posted here. If you saw it already then please ignore it.
Avatar of gdunn59

ASKER

Martin Liss:

I shut down my computer last night, so it was already rebooted.
Avatar of gdunn59

ASKER

Martin Liss:

The comment you deleted was that the one where you were saying that it was working for you?
Add these two lines at the bottom of the Cleanup_Data macro.
ActiveSheet.Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Open in new window

Avatar of gdunn59

ASKER

Martin Liss:

I added the two lines at the bottom of the Cleanup_Data macro, and the same thing is still happening.

ActiveSheet.Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove  
There are two header lines in the table on Dupes_Removed sheet and I am assuming that what you are looking for is for those two headers to start in row 2.

The attached workbook which contains the two new lines of code does that
User generated image29223908.xlsm
Avatar of gdunn59

ASKER

Martin Liss:

No, I do not want 2 rows of headers.  

There should only be 1 row of headers (that start on Row 2), as follows

 
AERO_RATINGIDE_COMPLETEPME_COMPLETEIS_COMMANDERIS_SELECTEDNOT_SELECTEDRACEARF_ANALYSIS_ID2AFSC3AFSCAERO_RATING_CURRAFR_SECTION_IDARF_ANALYSIS_ID_1BRD_IDBRD_SEQCOMP_CATDAFSC_CURRIS_COMMANDER_OLDDATE_COMPLETEDELIG_ZONEETHNIC_GROUPHIST_TOTAL_PTS_1HIST_TOTAL_PTS_2HIST_TOTAL_PTS_3HIST_TOTAL_PTS_4NAMEPAFSCPAS_ATCH_TNGPAS_CURRPOSN_NR_CURRPROM_DOPM_NUM_PASSRACE_1OPR_RATINGRECOMMEND_CODESEL_STATPERCENT_SELECTED_COLUMNSEXCSRIDSRID_EVAL_GROUP_SIZESRID_EVAL_ORDERSSANHISPANIC_DECLARATIONblank
MAX(PME.DATE_COMPLETED)MAX(PME.METHOD)MAX(OPR.CLOSE_DATE)PME_PROGRAMIS_PME_COMPLETEMAX(PME.PROGRAM)PROGRAM_LEVELMAX(EDU.PROGRAM_LEVEL)

All of the column headings in Italics are the "new" columns that are added with my code.

Thanks!
To avoid more misunderstanding on my part, please show me a picture of the first three rows of a manually created Dupes_Removed sheet that's the way you want it.
Avatar of gdunn59

ASKER

Martin Liss:

This is what the final sheet should look like (starting in Row 1):
 
AERO_RATINGIDE_COMPLETEPME_COMPLETEIS_COMMANDERIS_SELECTEDNOT_SELECTEDRCARF_ANALYSIS_ID2AFSC3AFSCAERO_RATING_CURRAFR_SECTION_IDARF_ANALYSIS_ID_1BRD_IDBRD_SEQCOMP_CATDAFSC_CURRIS_COMMANDER_OLDDATE_COMPLETEDELIG_ZONEETHNIC_GROUPHIST_TOTAL_PTS_1HIST_TOTAL_PTS_2HIST_TOTAL_PTS_3HIST_TOTAL_PTS_4NAMEPAFSCPAS_ATCH_TNGPAS_CURRPOSN_NR_CURRPROM_DOPM_NUM_PASSRACE_1OPR_RATINGRECOMMEND_CODESEL_STATPERCENT_SELECTED_COLUMNSEXCSRIDSRID_EVAL_GROUP_SIZESRID_EVAL_ORDERSSANHISPANIC_DECLARATIONblank
MAX(PME.DATE_COMPLETED)MAX(PME.METHOD)MAX(OPR.CLOSE_DATE)
PIASRT43T

B99FV05100000AX 43TNO01-JUL-10BX0000DOE, JOHN43THH3VFS73IF
1XXXXS1X0I1

1100000012110000001
01-JUL-102230-OCT-18PDX0QBXXXX

ASRT43T

B99FV05100000AX 43TNO01-JUL-10BX0000DOE, JOHN43THH3VFS73IF
1XXXXS
X0I2

1100000002110000000
01-JUL-102230-OCT-19PDX0QBXXXX

ASRT43T

B99FV05100000AX 43TNO28-FEB-17BX0000DOE, JOHN43THH3VFS73IF
1XXXXS
X0I3

1100000002110000000
28-FEB-172230-OCT-18IDE1IIXXXX

I rewrote some of the code.
29223908a.xlsm
Avatar of gdunn59

ASKER

Martin Liss:

Ok.  Let me take a look and I will get back to you.  Thanks
Avatar of gdunn59

ASKER

Martin Liss:

It's not letting me open the file with Excel.

Get error saying file format or file extension is invalid.

I was able to open it but Excel found some things that needed to be repaired. Try this one.
29223908b.xlsm
Avatar of gdunn59

ASKER

Martin Liss:

Ok.  I'll try the new one.

Thanks!
Avatar of gdunn59

ASKER

Martin Liss:

It still won't let me.  It will open on the internet, but not with excel.  I cannot see the code.


I have no idea what's going on but here's the code I used.
Sub Cleanup_Data()

' check if Dups_Removed sheet exists if so Delete it
    Dim xWs As Worksheet
    Dim sheetName As String
    Dim lngLastRow As Long
    Dim DataTable As ListObject
    
    sheetName = "Dups_Removed"
    lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    On Error Resume Next
    
    Set xWs = Sheets(sheetName)
        xWs.Delete
       
    Application.DisplayAlerts = True

    Sheets.Add After:=Sheets("Data_With_Dups")
    ActiveSheet.Name = "Dups_Removed"
    Sheets("Data_With_Dups").Range("B2:AY" & lngLastRow).Copy
    
    With Sheets("Dups_Removed")
        .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                   :=False, Transpose:=False
        .Range("B1") = "IDE_COMPLETE"
        .Range("C1") = "PME_COMPLETE"
        lngLastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        .ListObjects.Add(xlSrcRange, .Range("A1:AY" & lngLastRow), , xlYes).Name = "Pivot_Table"
    End With


ActiveSheet.ListObjects("Pivot_Table").DataBodyRange.Select
    
' Populate PME_Complete column with "yes" or "no" based off of if PME_Program is "IDE"
    Range("Pivot_Table[[#Headers],[PME_COMPLETE]]").Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=IF([@[PME_PROGRAM]]=""IDE"",""YES"",""NO"")"
    
    Range("B2").AutoFilter
    

' sorts the PME_Complete column
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[PME_COMPLETE]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
' sorts the OPR.Close_Date column
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[MAX(OPR.CLOSE_DATE)]]"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
' sort the "blank" column that contains SSNs
'    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
'        SortFields.Add Key:=Range("Pivot_Table[[#All],[blank]]"), _
'        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
'    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
'        .Header = xlYes
'        .MatchCase = False
'        .Orientation = xlTopToBottom
'        .SortMethod = xlPinYin
'        .Apply
'    End With
   
' remove duplicates based off of Column 40 which is called "blank" and contains SSNs
    ActiveSheet.Range("Pivot_Table[#ALL]").RemoveDuplicates Columns:=40, Header _
        :=xlYes
        
' add new column for IS_COMMANDER as column 4
    DataTable.ListColumns.Add(4).Name = "IS_COMMANDER"
    Range("Pivot_Table[[#Headers],[IS_COMMANDER]]").Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=IF(LEFT([@[DAFSC_CURR]])=""C"",1,0)"
    
' add new column for Is_Selected as column 5
    DataTable.ListColumns.Add(5).Name = "IS_SELECTED"
    Range("Pivot_Table[[#Headers],[IS_SELECTED]]").Offset(1, 0).Select
    
' populate Is_Selected column with a 1 or 0 based off of if Sel_Stat field is an "S"
    ActiveCell.FormulaR1C1 = "=IF([@[SEL_STAT]]=""S"",1,0)"
    
' add new column Not_Selected as column 6
    DataTable.ListColumns.Add(6).Name = "NOT_SELECTED"
    Range("Pivot_Table[[#Headers],[NOT_SELECTED]]").Offset(1, 0).Select
    
' populate Not_Selected column with a 0 or 1
    ActiveCell.FormulaR1C1 = "=IF([@[SEL_STAT]]=""S"",0,1)"
            
' select Dups_Removed sheet and change tab color
    Sheets("Dups_Removed").Select
    With ActiveWorkbook.Sheets("Dups_Removed").Tab
'        .Color = 49407
        .Color = 49990
        .TintAndShade = 0
    End With

' delete blank Column A and blank Row 1
'Columns("A:A").Select
'Selection.Delete Shift:=xlToLeft
'ActiveSheet.Rows("1:1").Select
'Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Application.ScreenUpdating = True
End Sub

Open in new window

Avatar of gdunn59

ASKER

Martin Liss:

Not sure either unless its being blocked through our network.
Avatar of gdunn59

ASKER

Martin Liss:

I try the new code you provided.

Thanks!
Not sure either unless its being blocked through our network.
That makes sense if they are worried about workbooks that contain code, and in that case if you need it I can put the workbook in a zip file which will probably get by the restrictions.
Avatar of gdunn59

ASKER

Martin Liss:

Still not working 100%.

It only added 2 of the new fields (the 2 that are in italics):
 
AERO_RATINGIDE_COMPLETEPME_COMPLETE2AFSC3AFSCAERO_RATING_CURRAFR_SECTION_IDARF_ANALYSIS_ID_1BRD_IDBRD_SEQCOMP_CATDAFSC_CURRIS_COMMANDER_OLDDATE_COMPLETEDELIG_ZONEETHNIC_GROUPHIST_TOTAL_PTS_1HIST_TOTAL_PTS_2HIST_TOTAL_PTS_3HIST_TOTAL_PTS_4NAMEPAFSCPAS_ATCH_TNGPAS_CURRPOSN_NR_CURRPROM_DOPM_NUM_PASSRACE_1OPR_RATINGRECOMMEND_CODESEL_STATPERCENT_SELECTED_COLUMNSEXCSRIDSRID_EVAL_GROUP_SIZESRID_EVAL_ORDERSSANHISPANIC_DECLARATIONblankColumn1MAX(PME.DATE_COMPLETED)MAX(PME.METHOD)MAX(OPR.CLOSE_DATE)PME_PROGRAMIS_PME_COMPLETEMAX(PME.PROGRAM)PROGRAM_LEVELMAX(EDU.PROGRAM_LEVEL)Column2Column3Column4Column5

So all the data is not falling in the right columns.

It should look like this:

AERO_RATINGIDE_COMPLETEPME_COMPLETEIS_COMMANDERIS_SELECTEDNOT_SELECTEDRCARF_ANALYSIS_ID2AFSC3AFSCAERO_RATING_CURRAFR_SECTION_IDARF_ANALYSIS_ID_1BRD_IDBRD_SEQCOMP_CATDAFSC_CURRIS_COMMANDER_OLDDATE_COMPLETEDELIG_ZONEETHNIC_GROUPHIST_TOTAL_PTS_1HIST_TOTAL_PTS_2HIST_TOTAL_PTS_3HIST_TOTAL_PTS_4NAMEPAFSCPAS_ATCH_TNGPAS_CURRPOSN_NR_CURRPROM_DOPM_NUM_PASSRACE_1OPR_RATINGRECOMMEND_CODESEL_STATPERCENT_SELECTED_COLUMNSEXCSRIDSRID_EVAL_GROUP_SIZESRID_EVAL_ORDERSSANHISPANIC_DECLARATIONblank
MAX(PME.DATE_COMPLETED)MAX(PME.METHOD)MAX(OPR.CLOSE_DATE)

The highlighted/italics are the new columns that should be added.  The newest code only added the first 2 (IDE_Complete and PME_Complete).

Thanks!
Add lines like my lines 29 and 30 for the headings you want added.
Avatar of gdunn59

ASKER

Martin Liss:

Ok.  I will add the other lines of code for the other new columns.

Thanks!
Avatar of gdunn59

ASKER

Martin Liss:

I added the lines of code for the other new columns.  It added the new column headings but the data in the columns is not correct because it needs to move the existing columns over as the new columns are added.
Avatar of gdunn59

ASKER

Martin Liss:
So the new columns should be added starting between "AERO_RATING" AND "RACE", as indicated below:

 
AERO_RATINGRACEARF_ANALYSIS_ID2AFSC3AFSCAERO_RATING_CURRAFR_SECTION_IDARF_ANALYSIS_ID_1BRD_IDBRD_SEQCOMP_CATDAFSC_CURRIS_COMMANDER_OLDDATE_COMPLETEDELIG_ZONE

It added the new column headings as indicated above, but the data for those columns didn't move to the right.  So the data is wrong in the columns.
Please paste your code here.
Avatar of gdunn59

ASKER

Martin Liss:

Here you go.  All I did was copy your latest code and added the other lines of code for the missing new columns.  Thanks!

Sub Cleanup_Data()

' check if Dups_Removed sheet exists if so Delete it
    Dim xWs As Worksheet
    Dim sheetName As String
    Dim lngLastRow As Long
    Dim DataTable As ListObject
    
    sheetName = "Dups_Removed"
    lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    On Error Resume Next
    
    Set xWs = Sheets(sheetName)
        xWs.Delete
       
    Application.DisplayAlerts = True

    Sheets.Add After:=Sheets("Data_With_Dups")
    ActiveSheet.Name = "Dups_Removed"
    Sheets("Data_With_Dups").Range("B2:AY" & lngLastRow).Copy
    
    With Sheets("Dups_Removed")
        .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                   :=False, Transpose:=False
        .Range("B1") = "IDE_COMPLETE"
        .Range("C1") = "PME_COMPLETE"
        .Range("D1") = "IS_COMMANDER"
        .Range("E1") = "IS_SELECTED"
        .Range("F1") = "NOT_SELECTED"
        lngLastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        .ListObjects.Add(xlSrcRange, .Range("A1:AY" & lngLastRow), , xlYes).Name = "Pivot_Table"
    End With


ActiveSheet.ListObjects("Pivot_Table").DataBodyRange.Select
    
' Populate PME_Complete column with "yes" or "no" based off of if PME_Program is "IDE"
    Range("Pivot_Table[[#Headers],[PME_COMPLETE]]").Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=IF([@[PME_PROGRAM]]=""IDE"",""YES"",""NO"")"
    
    Range("B2").AutoFilter
    

' sorts the PME_Complete column
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[PME_COMPLETE]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
' sorts the OPR.Close_Date column
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[MAX(OPR.CLOSE_DATE)]]"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
' sort the "blank" column that contains SSNs
'    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
'        SortFields.Add Key:=Range("Pivot_Table[[#All],[blank]]"), _
'        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
'    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
'        .Header = xlYes
'        .MatchCase = False
'        .Orientation = xlTopToBottom
'        .SortMethod = xlPinYin
'        .Apply
'    End With
   
' remove duplicates based off of Column 40 which is called "blank" and contains SSNs
    ActiveSheet.Range("Pivot_Table[#ALL]").RemoveDuplicates Columns:=40, Header _
        :=xlYes
        
' add new column for IS_COMMANDER as column 4
    DataTable.ListColumns.Add(4).Name = "IS_COMMANDER"
    Range("Pivot_Table[[#Headers],[IS_COMMANDER]]").Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=IF(LEFT([@[DAFSC_CURR]])=""C"",1,0)"
    
' add new column for Is_Selected as column 5
    DataTable.ListColumns.Add(5).Name = "IS_SELECTED"
    Range("Pivot_Table[[#Headers],[IS_SELECTED]]").Offset(1, 0).Select
    
' populate Is_Selected column with a 1 or 0 based off of if Sel_Stat field is an "S"
    ActiveCell.FormulaR1C1 = "=IF([@[SEL_STAT]]=""S"",1,0)"
    
' add new column Not_Selected as column 6
    DataTable.ListColumns.Add(6).Name = "NOT_SELECTED"
    Range("Pivot_Table[[#Headers],[NOT_SELECTED]]").Offset(1, 0).Select
    
' populate Not_Selected column with a 0 or 1
    ActiveCell.FormulaR1C1 = "=IF([@[SEL_STAT]]=""S"",0,1)"
            
' select Dups_Removed sheet and change tab color
    Sheets("Dups_Removed").Select
    With ActiveWorkbook.Sheets("Dups_Removed").Tab
'        .Color = 49407
        .Color = 49990
        .TintAndShade = 0
    End With

' delete blank Column A and blank Row 1
'Columns("A:A").Select
'Selection.Delete Shift:=xlToLeft
'ActiveSheet.Rows("1:1").Select
'Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Application.ScreenUpdating = True
End Sub

Open in new window

Here's a picture where I've added a sequential number in the 3rd row of the Data_With_Dupes sheet. Can you show me a picture of what the first two rows of the Dupes_Removed sheet should look like after the new columns are inserted. I would expect that in your picture the inserted columns would have no number in row 2.User generated imageShould the new columns push the right edge of the table past AY or will only the data shift? In other words will the "X" that's currently in the MAX(OPR.CLOSE_DATE) column wind up under the MAX(PME.PROGRAM) column?
Avatar of gdunn59

ASKER

Martin Liss:

This is what the final outcome should look like:
 
AERO_RATINGIDE_COMPLETEPME_COMPLETEIS_COMMANDERIS_SELECTEDNOT_SELECTEDRACEARF_ANALYSIS_ID2AFSC3AFSCAERO_RATING_CURRAFR_SECTION_IDARF_ANALYSIS_ID_1BRD_IDBRD_SEQCOMP_CATDAFSC_CURRIS_COMMANDER_OLDDATE_COMPLETEDELIG_ZONEETHNIC_GROUPHIST_TOTAL_PTS_1HIST_TOTAL_PTS_2HIST_TOTAL_PTS_3HIST_TOTAL_PTS_4NAMEPAFSCPAS_ATCH_TNGPAS_CURRPOSN_NR_CURRPROM_DOPM_NUM_PASSRACE_1OPR_RATINGRECOMMEND_CODESEL_STATPERCENT_SELECTED_COLUMNSEXCSRIDSRID_EVAL_GROUP_SIZESRID_EVAL_ORDERSSANHISPANIC_DECLARATIONblankColumn1MAX(PME.DATE_COMPLETED)MAX(PME.METHOD)MAX(OPR.CLOSE_DATE)PME_PROGRAMIS_PME_COMPLETEMAX(PME.PROGRAM)PROGRAM_LEVELMAX(EDU.PROGRAM_LEVEL)Column2Column3Column4
P
YES010WH AK11B
BB0G519A0001XXAT11NO23-FEB-19EY0000DOE, JOHN11B
U60M0777M0E
DS
M0M1U6

1111111113111111111734623-FEB-19231-OCT-19IDE1IIMASP


N
YES001WH R12ST128B0F519A0001XXAK12NO23-MAY-17EY0000DOE, JANEQ12
W60M0827M0E
DN
F0M1W6

1111111123111111112734623-MAY-17231-OCT-19IDE1IIMASP



So all the column headers should be on one line with actual names not just Column1, Column2, etc.
I'm sorry but that totally confuses me. There are no column letters that I can use as a reference and it doesn't have the numbers in row 2 like in my picture so I can't tell for sure what is shifted, so could you please dummy up a workbook with a few rows in Data_With_Dups and what Dups_Removed should look like after processing?
Avatar of gdunn59

ASKER

Martin Liss:

Here's the workbook with a few rows in Data_With_Dups and Dups_Removed.

Thanks!

EE.xlsx

In your initial question you indicated that the Data_With_Dups data was in range B:AY but in your new sample the data is in A:BC or if the last three blank columns are ignored, A:AZ. Which range is correct?
Avatar of gdunn59

ASKER

Martin Liss:

That is because I have code at the end that deletes the blank first row & blank first column.

That is the final outcome.
Sub Cleanup_Data()

' check if Dups_Removed sheet exists if so Delete it
    Dim xWs As Worksheet
    Dim sheetName As String
    Dim lngLastRow As Long
    Dim lngLastCol As Long
    Dim strLastCol As String
    Dim DataTable As ListObject
    
    sheetName = "Dups_Removed"
    lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    On Error Resume Next
    
    Set xWs = Sheets(sheetName)
        xWs.Delete
       
    Application.DisplayAlerts = True

    Sheets.Add After:=Sheets("Data_With_Dups")
    ActiveSheet.Name = "Dups_Removed"
    Sheets("Data_With_Dups").Range("B2:AY" & lngLastRow).Copy
    
    With Sheets("Dups_Removed")
        .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                   :=False, Transpose:=False
        .Range("B1") = "IDE_COMPLETE"
        .Range("C1") = "PME_COMPLETE"
        .Range("D1") = "IS_COMMANDER"
        .Range("E1") = "IS_SELECTED"
        .Range("F1") = "NOT_SELECTED"
        .Range("G1") = "RACE"
        .Range("AY1") = "PROGRAM_LEVEL"
        .Range("AZ1") = "MAX(EDU.PROGRAM_LEVEL)"
        lngLastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        lngLastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        strLastCol = Split(Cells(1, lngLastCol).Address, "$")(1)
        .ListObjects.Add(xlSrcRange, .Range("A1:" & strLastCol & lngLastRow), , xlYes).Name = "Pivot_Table"
    End With


    'ActiveSheet.ListObjects("Pivot_Table").DataBodyRange.Select
    
' Populate PME_Complete column with "yes" or "no" based off of if PME_Program is "IDE"
    Range("Pivot_Table[[#Headers],[PME_COMPLETE]]").Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=IF([@[PME_PROGRAM]]=""IDE"",""YES"",""NO"")"
    
    Range("B2").AutoFilter
    

' sorts the PME_Complete column
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[PME_COMPLETE]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
' sorts the OPR.Close_Date column
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[MAX(OPR.CLOSE_DATE)]]"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
' sort the "blank" column that contains SSNs
'    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
'        SortFields.Add Key:=Range("Pivot_Table[[#All],[blank]]"), _
'        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
'    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
'        .Header = xlYes
'        .MatchCase = False
'        .Orientation = xlTopToBottom
'        .SortMethod = xlPinYin
'        .Apply
'    End With
   
' remove duplicates based off of Column 40 which is called "blank" and contains SSNs
    ActiveSheet.Range("Pivot_Table[#ALL]").RemoveDuplicates Columns:=40, Header _
        :=xlYes
        
' add new column for IS_COMMANDER as column 4
    DataTable.ListColumns.Add(4).Name = "IS_COMMANDER"
    Range("Pivot_Table[[#Headers],[IS_COMMANDER]]").Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=IF(LEFT([@[DAFSC_CURR]])=""C"",1,0)"
    
' add new column for Is_Selected as column 5
    DataTable.ListColumns.Add(5).Name = "IS_SELECTED"
    Range("Pivot_Table[[#Headers],[IS_SELECTED]]").Offset(1, 0).Select
    
' populate Is_Selected column with a 1 or 0 based off of if Sel_Stat field is an "S"
    ActiveCell.FormulaR1C1 = "=IF([@[SEL_STAT]]=""S"",1,0)"
    
' add new column Not_Selected as column 6
    DataTable.ListColumns.Add(6).Name = "NOT_SELECTED"
    Range("Pivot_Table[[#Headers],[NOT_SELECTED]]").Offset(1, 0).Select
    
' populate Not_Selected column with a 0 or 1
    ActiveCell.FormulaR1C1 = "=IF([@[SEL_STAT]]=""S"",0,1)"
            
' select Dups_Removed sheet and change tab color
    Sheets("Dups_Removed").Select
    With ActiveWorkbook.Sheets("Dups_Removed").Tab
'        .Color = 49407
        .Color = 49990
        .TintAndShade = 0
    End With

' delete blank Column A and blank Row 1
'Columns("A:A").Select
'Selection.Delete Shift:=xlToLeft
'ActiveSheet.Rows("1:1").Select
'Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    ' Unselect range
    Range("A1").Select
    Application.CutCopyMode = False

    Application.ScreenUpdating = True
End Sub

Open in new window

Avatar of gdunn59

ASKER

Martin Liss:

I just tried the code you last posted, and I am still having the same issue where it is inserting the new column headers, but the data is not moving to the right to match up with the headers, so the data in the columns is not correct.

I thought I would go back to square one.  Here is my original code that was working, other than I wanted a way to have it select the range (from the first row of data which starts on Row 2, Column B, and go to the very last Row/Column that contains data).  So this is all that is really missing.

In my posted code here, I have the code written so that it starts in Row 2/Column B, and goes to the very last Row/Column (AY1048576) available in an excel spreadsheet.


Sub Cleanup_Data()

' check if Dups_Removed sheet exists if so Delete it
    Dim xWs As Worksheet
    Dim sheetName As String
    sheetName = "Dups_Removed"
    
    Application.DisplayAlerts = False
    Err.Clear
    On Error Resume Next
    
    Set xWs = Sheets(sheetName)
        xWs.Delete
       
    Application.DisplayAlerts = True

' create copy of data (data contains dups - will remove the dups later in the code)
    Sheets("Data_With_Dups").Copy After:=Sheets("Data_With_Dups")
    Sheets("Data_With_Dups (2)").Name = "Dups_Removed"
    
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$2:$AY$1048576"), , xlYes).Name _
        = "Pivot_Table"
    Set DataTable = ActiveSheet.ListObjects("Pivot_Table")
       
' add new column for IDE_COMPLETE as Column 2
    DataTable.ListColumns.Add(2).Name = "IDE_COMPLETE"
    
' add new column for PME_COMPLETE as Column 3
    DataTable.ListColumns.Add(3).Name = "PME_COMPLETE"

' Populate PME_Complete column with "yes" or "no" based off of if PME_Program is "IDE"
    Range("Pivot_Table[[#Headers],[PME_COMPLETE]]").Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=IF([@[PME_PROGRAM]]=""IDE"",""YES"",""NO"")"
    
    Range("B2").AutoFilter

' sorts the PME_Complete column
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[PME_COMPLETE]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
' sorts the OPR.Close_Date column
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[MAX(OPR.CLOSE_DATE)]]"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
' sort the "blank" column that contains SSNs
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[blank]]"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
' remove duplicates based off of Column 40 which is called "blank" and contains SSNs
    ActiveSheet.Range("Pivot_Table[#ALL]").RemoveDuplicates Columns:=40, Header _
        :=xlYes
        
' add new column for IS_COMMANDER as column 4
    DataTable.ListColumns.Add(4).Name = "IS_COMMANDER"
    Range("Pivot_Table[[#Headers],[IS_COMMANDER]]").Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=IF(LEFT([@[DAFSC_CURR]])=""C"",1,0)"
    
' add new column for Is_Selected as column 5
    DataTable.ListColumns.Add(5).Name = "IS_SELECTED"
    Range("Pivot_Table[[#Headers],[IS_SELECTED]]").Offset(1, 0).Select
    
' populate Is_Selected column with a 1 or 0 based off of if Sel_Stat field is an "S"
    ActiveCell.FormulaR1C1 = "=IF([@[SEL_STAT]]=""S"",1,0)"
    
' add new column Not_Selected as column 6
    DataTable.ListColumns.Add(6).Name = "NOT_SELECTED"
    Range("Pivot_Table[[#Headers],[NOT_SELECTED]]").Offset(1, 0).Select
    
' populate Not_Selected column with a 0 or 1
    ActiveCell.FormulaR1C1 = "=IF([@[SEL_STAT]]=""S"",0,1)"
            
' select Dups_Removed sheet and change tab color
    Sheets("Dups_Removed").Select
    With ActiveWorkbook.Sheets("Dups_Removed").Tab
'        .Color = 49407
        .Color = 49990
        .TintAndShade = 0
    End With

' delete blank Column A and blank Row 1
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

Rows("1:1").Select
Selection.Delete Shift:=xlUp
      
End Sub

Open in new window



Please show me a picture of the first 3 rows of my output and a picture of the first 3 rows of my output altered so that it is correct. To do the latter it might help if you went to the Immediate Window and typed ActiveSheet.listobjects(1).unlist and press Return, and when you are done with the changes change it back to a table.
Avatar of gdunn59

ASKER

Martin Liss:

I understand that you want me to add this to the immediate window:

ActiveSheet.listobjects(1).unlist 

But I'm not sure what/where I need to change the code.

Thanks!
I'm not asking you to change the code. Please just manually adjust the columns and/or data of my output so that it is correct and show me a picture (or a workbook) of the results.
Avatar of gdunn59

ASKER

Martin Liss:

I believe I finally got everything to work.  I just went back to my original code and inserted the following code:

    LR = Cells(Rows.Count, 1).End(xlUp).Row
    LC = Cells(1, Columns.Count).End(xlToLeft).Column

    Dim Rng As Range
    Set Rng = Cells(1, 1).Resize(LR, LC)

    Dim Ws As Worksheet
    Set Ws = ActiveSheet

    Ws.ListObjects.Add xlSrcRange, xllistobjecthasheaders:=xlYes, Destination:=Rng
    Ws.ListObjects(1).Name = "Pivot_Table"

I added several more rows and it seemed to recognize them.  I also tried it with only 89 rows and it also selected just those rows for the Pivot_Table.

Sub Cleanup_Data()

' check if Dups_Removed sheet exists if so Delete it
    Dim xWs As Worksheet
    Dim sheetName As String
    sheetName = "Dups_Removed"
    
    Application.DisplayAlerts = False
    Err.Clear
    On Error Resume Next
    
    Set xWs = Sheets(sheetName)
        xWs.Delete
       
    Application.DisplayAlerts = True

' create copy of data (data contains dups - will remove the dups later in the code)
    Sheets("Data_With_Dups").Copy After:=Sheets("Data_With_Dups")
    Sheets("Data_With_Dups (2)").Name = "Dups_Removed"

    LR = Cells(Rows.Count, 1).End(xlUp).Row
    LC = Cells(1, Columns.Count).End(xlToLeft).Column

    Dim Rng As Range
    Set Rng = Cells(1, 1).Resize(LR, LC)

    Dim Ws As Worksheet
    Set Ws = ActiveSheet

    Ws.ListObjects.Add xlSrcRange, xllistobjecthasheaders:=xlYes, Destination:=Rng
    Ws.ListObjects(1).Name = "Pivot_Table"
    
Set DataTable = ActiveSheet.ListObjects("Pivot_Table")

' add new column for IDE_COMPLETE as Column 2
    DataTable.ListColumns.Add(2).Name = "IDE_COMPLETE"
    
' add new column for PME_COMPLETE as Column 3
    DataTable.ListColumns.Add(3).Name = "PME_COMPLETE"

' Populate PME_Complete column with "yes" or "no" based off of if PME_Program is "IDE"
    Range("Pivot_Table[[#Headers],[PME_COMPLETE]]").Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=IF([@[PME_PROGRAM]]=""IDE"",""YES"",""NO"")"
    
    Range("B2").AutoFilter

' sorts the PME_Complete column
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[PME_COMPLETE]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
' sorts the OPR.Close_Date column
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[MAX(OPR.CLOSE_DATE)]]"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
' sort the "blank" column that contains SSNs
    ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort. _
        SortFields.Add Key:=Range("Pivot_Table[[#All],[blank]]"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dups_Removed").ListObjects("Pivot_Table").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
' remove duplicates based off of Column 40 which is called "blank" and contains SSNs
    ActiveSheet.Range("Pivot_Table[#ALL]").RemoveDuplicates Columns:=40, Header _
        :=xlYes
        
' add new column for IS_COMMANDER as column 4
    DataTable.ListColumns.Add(4).Name = "IS_COMMANDER"
    Range("Pivot_Table[[#Headers],[IS_COMMANDER]]").Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=IF(LEFT([@[DAFSC_CURR]])=""C"",1,0)"
    
' add new column for Is_Selected as column 5
    DataTable.ListColumns.Add(5).Name = "IS_SELECTED"
    Range("Pivot_Table[[#Headers],[IS_SELECTED]]").Offset(1, 0).Select
    
' populate Is_Selected column with a 1 or 0 based off of if Sel_Stat field is an "S"
    ActiveCell.FormulaR1C1 = "=IF([@[SEL_STAT]]=""S"",1,0)"
    
' add new column Not_Selected as column 6
    DataTable.ListColumns.Add(6).Name = "NOT_SELECTED"
    Range("Pivot_Table[[#Headers],[NOT_SELECTED]]").Offset(1, 0).Select
    
' populate Not_Selected column with a 0 or 1
    ActiveCell.FormulaR1C1 = "=IF([@[SEL_STAT]]=""S"",0,1)"
            
' select Dups_Removed sheet and change tab color
    Sheets("Dups_Removed").Select
    With ActiveWorkbook.Sheets("Dups_Removed").Tab
'        .Color = 49407
        .Color = 49990
        .TintAndShade = 0
    End With

' delete blank Column A and blank Row 1
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

Rows("1:1").Select
Selection.Delete Shift:=xlUp
      
End Sub


Open in new window

I'm happy you resolved it.
Avatar of gdunn59

ASKER

Martin Liss:

Thank you for all your time and assistance.
ASKER CERTIFIED SOLUTION
Avatar of gdunn59
gdunn59

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of gdunn59

ASKER

Martin Liss:

Is it possible for you to still be awarded some of the points since you were very persistent in trying to get this to work?

Thanks!
Sure, just go back in and select one of my answers as a solution.
Thank you for the points.
Avatar of gdunn59

ASKER

You're welcome!