VB Code to Sort by Last Column With Date Not Including Headers

[KristenA]

I have a workbook that with have a changing number of columns each month. The second to last column always contains a header and yes and no values. The last column always contains a header and yes and blank values. The number of rows will also vary over time. (Example attached, but with a lot fewer rows).

My main concern is finding code that will find the last (or second to last) column with data below the headers and sort the spreadsheet by that column. The code would find the second to last column and sort by that first, followed by some other actions that I already have code for, then sort by the last column, which would be followed by other actions that I already have code for.

I looked at the "Find First or Last Populated Column in a sheet" Knowledge Base article, but I'm not skilled enough to take what I found there and adjust it to my needs. If anyone is able to help me out, that would be awesome. Thanks!

[GTO]

Hi Kristen,

Welcome to vbaexpress

In a Junk Copy of your wb, let us see if this is on the right path.

In a Standard Module:

[VBA]
Option Explicit

Sub example()
Dim rngLastCell As Range
Dim rngToSort As Range
Dim lLasCol As Long

With shtTracker
'// This just uses a function to house the .Find Method with optional arguments,//
'// so that I have "defaults" so-to-speak, as to finding the last empty row or //
'// column. Note that when we Set, we are setting a reference to the range (the//
'// cell) object. We want to do this first and get the row or column later, to //
'// avoid errors if we don't find any data in the search range. //
Set rngLastCell = _
RangeFound(SearchRange:=.Range(.Cells(2, "I"), .Cells(.Rows.Count, .Columns.Count)), SearchRowCol:=xlByColumns)

'// Two tests, one to see if we found a "last column" from Col I and thereafter;//
'// the second to ensure that we have at least one 'survey' and 'survey results'//
'// column. //
If rngLastCell Is Nothing Then
MsgBox "No Data"
Exit Sub

If rngLastCell.Column < 10 Then
MsgBox "ACK!, no survey results!"
Exit Sub
End If
End If

'// If we made it this far, we can use lLastCol and lLastCol - 1 for the remainder //
lLasCol = rngLastCell.Column
MsgBox "Last column is: " & lLasCol

'// Now we'll find the last row with data, searching from Col A to the last column //
Set rngLastCell = RangeFound(.Range(.Cells(2, 1), .Cells(.Rows.Count, lLasCol)))
'// Then set a reference to the entire range to sort. //
Set rngToSort = .Range(.Cells(2, 1), .Cells(rngLastCell.Row, lLasCol))

'// With a copy of your sheet, run the macro recorder and sort for the second to //
'// last column as you want to. You can grab whatever arguments are needed, as well//
'// as the proper values. //
rngToSort.Sort .Cells(2, lLasCol - 1), xlAscending, , , , , , xlNo

'****Other code here, then the above line, ditching the -1 after lLastCol, then the
'****remainder of your code.
End With
End Sub

Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function
[/VBA]
Hope that helps,

Mark

[GTO]

Oopsie; forgot to tack in the attachment.

[KristenA]

Hi Mark!

Thank you for your quick response! Your help is greatly appreciated! (I can totally see applying this to so many other situations in my office). When I ran the macro, it gave me the error "Compile error: Variable not defined" and highlights shtTracker. I adjusted that line to read:

With ActiveWorkbook.Worksheets("Tracker")

The error went away and I received the message that the last column is 14, which is correct. I ran it on a test version of my real spreadsheet and received the correct column in the message.

I will try recording the macro and inserting the code into this and will write back with the results.

Thanks!
Kristen

[CatDaddy]

[vba]Sub test()
Dim lastRow As Long, lastCol As Long, filterCol As Long
Dim keyR As Range, filterR As Range

ActiveWorkbook.Sheets("Tracker").Activate
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
filterCol = lastCol - 1

ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add key:=ActiveSheet.Cells(1, filterCol), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers

With ActiveSheet.Sort
.SetRange ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(lastRow, lastCol))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub[/vba]

[GTO]

Hi Mark!

Thank you for your quick response! Your help is greatly appreciated! (I can totally see applying this to so many other situations in my office). When I ran the macro, it gave me the error "Compile error: Variable not defined" and highlights shtTracker. I adjusted that line to read:

With ActiveWorkbook.Worksheets("Tracker")

The error went away and I received the message that the last column is 14, which is correct. I ran it on a test version of my real spreadsheet and received the correct column in the message.

I will try recording the macro and inserting the code into this and will write back with the results.

Thanks!
Kristen

Hi Kristen,

My apologies, it was a bit of a 'blond moment' on my end. I thought that I had tacked in an explanation of "shtTracker," but see that I did not.

If you will download the attachment at #3, you can see what I did better. In VBE, look in the Project Explorer window where modules/sheets/forms show. See how the worksheet has two names?

The first, 'shtTracker,' is the worksheet's CodeName. The second, '(Tracker)' is the name on the tab. I simply changed the sheet's CodeName down in the Properties window. By using the CodeName, if a user changes the worksheet's name (on the tab), the code still runs.

Mark

[KristenA]

So, after being side tracked at work by other pressing issues, I'm back working on this macro and I'm stuck again.

This is what my code looks like at the moment:

[VBA]

Sub TrackingMailMerge2()


'


' TrackingMailMerge2 Macro


'


'


Columns("F:G").Select


Selection.Delete Shift:=xlToLeft


Columns("F:F").Select


Selection.Delete Shift:=xlToLeft


Columns("A:A").Select


Selection.Copy


Columns("K:K").Select


Selection.Insert Shift:=xlToRight


Range("K1").Select


Application.CutCopyMode = False


ActiveCell.FormulaR1C1 = "Employer Email"


With ActiveCell.Characters(Start:=1, Length:=14).Font


.Name = "Tahoma"


.FontStyle = "Bold"


.Size = 11


.Strikethrough = False


.Superscript = False


.Subscript = False


.OutlineFont = False


.Shadow = False


.Underline = xlUnderlineStyleNone


.ColorIndex = 2


.TintAndShade = 0


.ThemeFont = xlThemeFontNone


End With


Columns("J:J").Select


Selection.Delete Shift:=xlToLeft


Range("J2").Select


ActiveCell.FormulaR1C1 = _


"=IF(ISBLANK(VLOOKUP(RC[-9],'PAX Status
Report'!C[-9]:C[13],23,FALSE)),"""",VLOOKUP(RC[-9],'PAX Status
Report'!C[-9]:C[13],23,FALSE))"


Range("J2").Select


Selection.Copy


Range("J3").Select


Range(Selection, Selection.End(xlDown)).Select


ActiveSheet.Paste


Columns("J:J").Select


Application.CutCopyMode = False


Selection.Copy


Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _


:=False, Transpose:=False


Columns("H:H").Select


Application.CutCopyMode = False


Selection.Cut


Columns("G:G").Select


Selection.Insert Shift:=xlToRight


Columns("G:G").Select


Selection.Cut


Columns("F:F").Select


Selection.Insert Shift:=xlToRight


Cells.Select


ActiveWindow.SmallScroll ToRight:=3


ActiveWorkbook.Worksheets("Tracking").Sort.SortFields.Clear


ActiveWorkbook.Worksheets("Tracking").Sort.SortFields.Add Key:=Range(
_


"O2:O1306"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=
_


xlSortNormal


With ActiveWorkbook.Worksheets("Tracking")


Set rngLastCell = RangeFound(SearchRange:=.Range(.Cells(2, "J"),
.Cells(.Rows.Count, .Columns.Count)), SearchRowCol:=xlByColumns)


If rngLastCell Is Nothing Then


MsgBox "No Data"


Exit Sub





If rngLastCell.Column < 11 Then


MsgBox "ACK!, no survey results!"


Exit Sub


End If


End If


lLasCol = rngLastCell.Column


MsgBox "Last column is: " & lLasCol


Set rngLastCell = RangeFound(.Range(.Cells(2, "A"),
.Cells(.Rows.Count, lLasCol)))


Set rngToSort = .Range(.Cells(1, "A"), .Cells(rngLastCell.Row,
lLasCol))


End With


With ActiveWorkbook.Worksheets("Tracking").Sort


.SetRange ActiveSheet.Range(ActiveSheet.Cells(1, 1),
ActiveSheet.Cells(rngLastCell.Row, lLasCol))


.Header = xlYes


.MatchCase = False


.Orientation = xlTopToBottom


.SortMethod = xlPinYin


.Apply


End With


Range("A1").Select





End Sub


Function RangeFound(SearchRange As Range, _


Optional ByVal FindWhat As String = "*", _


Optional StartingAfter As Range, _


Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _


Optional LookAtWholeOrPart As XlLookAt = xlPart, _


Optional SearchRowCol As XlSearchOrder = xlByRows, _


Optional SearchUpDn As XlSearchDirection = xlPrevious, _


Optional bMatchCase As Boolean = False) As Range





If StartingAfter Is Nothing Then


Set StartingAfter = SearchRange(1)


End If





Set RangeFound = SearchRange.Find(What:=FindWhat, _


After:=StartingAfter, _


LookIn:=LookAtTextOrFormula, _


LookAt:=LookAtWholeOrPart, _


SearchOrder:=SearchRowCol, _


SearchDirection:=SearchUpDn, _


MatchCase:=bMatchCase)


End Function
[/VBA]

My trouble seems to lie in the sorting and I'm not sure what the problem is. At the moment, I'm trying to just get the sorting by the last column with data to work and then I'll worry about the sorting by the second to last (which actually has to happen first). It just seems like it's not sorting by the last column, but rather the second to last. The second to last has data all the way down. The last column, however, has values of "Yes" and "No," but also blanks. Is this the source of the problem? I had thought it was due to a formula being in the last column, so I copied/pasted values, but that did not resolve the issue. Thoughts?

Thanks!

[CatDaddy]

did you try my code? i tested it and it worked fine

[KristenA]

Hi CatDaddy,

I just tried it and yes, it worked! Thank you! Now on to the next step!

[CatDaddy]

sort second to last the same way using (filtercol - 1)

[KristenA]

Now that I have the second to last column sorted, I want to filter that column to "No" and delete the "No" rows. I've done something like this before using a dynamic range, but I'm hitting an error.

The code:
[VBA]Sub TrackingMailMerge2()
'
' TrackingMailMerge2 Macro
'
'
Columns("F:G").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.Copy
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Range("K1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Employer Email"
With ActiveCell.Characters(Start:=1, Length:=14).Font
.Name = "Tahoma"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISBLANK(VLOOKUP(RC[-9],'PAX Status Report'!C[-9]:C[13],23,FALSE)),"""",VLOOKUP(RC[-9],'PAX Status Report'!C[-9]:C[13],23,FALSE))"
Range("J2").Select
Selection.Copy
Range("J3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Columns("J:J").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("H:H").Select
Application.CutCopyMode = False
Selection.Cut
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("G:G").Select
Selection.Cut
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Cells.Select
ActiveWindow.SmallScroll ToRight:=3
ActiveWorkbook.Worksheets("Tracking").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tracking").Sort.SortFields.Add Key:=Range( _
"O2:O1306"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
Dim lastRow As Long, lastCol As Long, filterCol As Long
Dim keyR As Range, filterR As Range
ActiveWorkbook.Sheets("Tracking").Activate
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
filterCol = lastCol - 1
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=ActiveSheet.Cells(1, filterCol), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveSheet.Sort
.SetRange ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(lastRow, filterCol))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
ActiveWorkbook.Names.Add Name:="DynamicRange", RefersToR1C1:= _
"=OFFSET(Tracking!R1C1,1,0,COUNTA(Tracking!C1)-1,26)"
ActiveWorkbook.Names("DynamicRange").Comment = ""
ActiveWindow.SmallScroll ToRight:=1
ActiveSheet.Range("=OFFSET(Tracking!R1C1,1,0,COUNTA(Tracking!C1)-1,26)").AutoFilter Field:=filterCol, Criteria1:="No"
Range("=OFFSET(Tracking!R1C1,1,0,COUNTA(Tracking!C1)-1,26)").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Selection.AutoFilter
End Sub[/VBA]

It's highlighting this row as the problem:
ActiveSheet.Range("=OFFSET(Tracking!R1C1,1,0,COUNTA(Tracking!C1)-1,26)").AutoFilter Field:=filterCol, Criteria1:="No"

I recorded a macro that names the dynamic range, filters my second to last column to "No", and deletes the rows displayed. I am trying to replace the rows with the dynamic range formula and the column # with the filtercol.

This is how the code looked when I recorded it:
[VBA]Selection.AutoFilter
ActiveWorkbook.Names.Add Name:="DynamicRange", RefersToR1C1:= _
"=OFFSET(Tracking!R1C1,1,0,COUNTA(Tracking!C1)-1,26)"
ActiveWorkbook.Names("DynamicRange").Comment = ""
ActiveWindow.SmallScroll ToRight:=1
ActiveSheet.Range("$A$1:$R$1306").AutoFilter Field:=15, Criteria1:="No"
Rows("2:90").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Selection.AutoFilter[/VBA]

Thoughts?

[CatDaddy]

is that a legitimate range reference?

[CatDaddy]

you could do something like:
[VBA]For i=Range(Rows.count,filtercol).End(xlup).Row to 1
if Range(i,filtercol) = "No" Then
Range(i,filtercol).EntireRow.Delete
End if
next i[/VBA]