adding sort to a complicated array of rabbit holes and ...

[Keebler]

so with the blanks (empty rows) conundrum solved, moving on to the next area

so, here is the working copy of the vba code from post 67

        Sub copyto_test_REMOVEBLANKS_b18() 'working  (by Shina67)

Dim sourceWS As Worksheet
Dim destinationWS As Worksheet
Dim sourceRange As Range
Dim destinationRange As Range
Dim lastRow As Long
Dim i As Long, J As Long
Dim destinationLastRow As Long
Dim emptyRow As Boolean
   
Set sourceWS = ThisWorkbook.Sheets("INDEX")
Set destinationWS = ThisWorkbook.Sheets("INDEX2")
   
lastRow = sourceWS.Cells(sourceWS.Rows.Count, "A").End(xlUp).row
   
Set sourceRange = sourceWS.Range("A3:aq" & lastRow)
   
destinationWS.Cells.Clear

For i = 1 To sourceRange.Rows.Count
emptyRow = True
For J = 1 To sourceRange.Columns.Count
If sourceRange.Cells(i, J).Value <> "" Then 'Alex B
emptyRow = False
Exit For
End If
Next J
If Not emptyRow Then
If Not destinationRange Is Nothing Then
Set destinationRange = Union(destinationRange, sourceRange.Rows(i))
Else
Set destinationRange = sourceRange.Rows(i)
End If
End If
Next i
   
destinationLastRow = destinationWS.Cells(destinationWS.Rows.Count, "A").End(xlUp).row
 
If Not destinationRange Is Nothing Then
If destinationLastRow > 0 Then
destinationRange.Copy destinationWS.Cells(destinationLastRow + 1, "A")
Else
destinationRange.Copy destinationWS.Range("A3")
End If
End If
destinationWS.Range("a2").EntireRow.Insert   'adds a empty row to the top of the output page (well row 2)

End Sub

so this thread is adding a sort feature for the 3 columns
they all need to be sorted alphabetically, but separately (of course)

the columns to be sorted column A, Q, and AG

the rows are a3: end of column; q3: end of column ag3:end of column

ive had some success with doing the sorting manually, but as one might notice quickly. it get tedious after a bit.
especially when all this needs to run every time the data fields are updated

 

[rabsofty]

you can use the sort command in vba

Range(Cells(startrow, startcol), Cells(endrow, endcol)).Sort Key1:=Range(Cells(startrow, startcol), Cells(endrow, endcol)), Order1:=xlAscending, Header:=xlNo, MatchCase:=False, Orientation:=xlTopToBottom

EG: for col A only (put the start and end row in)

startcol = 1
endcol= 1
Range(Cells(startrow, startcol), Cells(endrow, endcol)).Sort Key1:=Range(Cells(startrow, startcol), Cells(endrow, endcol)), Order1:=xlAscending, Header:=xlNo, MatchCase:=False, Orientation:=xlTopToBottom

for more help, click on the .sort word in you vba code and hit F1 key for more help

 

[Alex Blakenburg]

To be a little more specific, as a starting point add this to the bottom of your existing code.
I have a couple of concerns.
- it codes that you have a heading row in row 2, change this number if that is not the heading row
- this line is a concern in relation to what the range to be used is and whether there is a heading row
If there is no heading row and the data starts at row 3 then change the hdg row below to = 2 and Header:=xlYes to Header:=xlNo

    ' You would normally put these towards the top of the code but after > Set destinationWS = ThisWorkbook.Sheets("INDEX2")
    ' but try as is at the end first
    Dim destinationHdgRow As Long
    With destinationWS
        destinationHdgRow = 2                                           ' <--- Change this if that is not the heading row
        destinationLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set destinationRange = .Range(.Cells(destinationHdgRow, "A"), .Cells(destinationLastRow, "aq"))
    End With
    
    ' This would be the sort after the rest of the code has finished
    destinationRange.Sort _
        Key1:=Range("A" & destinationHdgRow), Order1:=xlAscending, _
        Key2:=Range("Q" & destinationHdgRow), Order2:=xlAscending, _
        Key3:=Range("AG" & destinationHdgRow), Order3:=xlAscending, _
        Header:=xlYes

 

[Keebler]

Alex B,
thank you for your suggestions.

there was an error

Run-time error '1004':
The sort reference is not valid. Make sure that it's within the data you
want to sort, and the first Sort By box isn't the same or blank.

the debug than highlights

destinationRange.Sort _
Key1:=Range("A" & destinationHdgRow), Order1:=xlAscending, _
Key2:=Range("Q" & destinationHdgRow), Order2:=xlAscending, _
Key3:=Range("AG" & destinationHdgRow), Order3:=xlAscending, _
Header:=xlYes

I stacked the VBA's and everything ran as expected until it got to the sort...

Sub copy_removeblanks_sort_test_b01()
'Sub copyto_nob_test()
'define variables
Dim lrow As Long, srow As Long, crow As Long, Irow As Long, erow As Long
Dim slist As String, srng As String, trng As String
Dim aws As Worksheet, tws As Worksheet
Dim rng As Range

'set constants
Set aws = ActiveSheet
Set tws = Sheets("INDEX")

lrow = tws.Range("e1") 'gets the last row of destination ws
If lrow <= 3 Then 'checks to make sure row is at least row 3
    trng = tws.Range("a3").Address
Else
    trng = tws.Cells(lrow + 1, 1).Address
End If

crow = aws.Range("e1") 'gets the last row of the current sheet
srow = aws.Range("h1") 'gets the first row of the current sheet
srng = "aq" & crow
slist = ("k" & srow & ":" & srng)

aws.Range(slist).Copy
tws.Range(trng).PasteSpecial (xlPasteValues)

'erow = tws.Range("e1")
'erng = "a" & erow
'Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
    

 ' Filter out blank or empty rows in the target worksheet
'    Set rng = tws.Range("A3:A" & lrow)
'    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'tws.AutoFilterMode = False
    
' ---------------- BLANK / EMPTY ROWS REMOVER (FILTER) ------------
'working                --------------  (by Shina67)
Application.CutCopyMode = False
Application.ScreenUpdating = True
 
    Dim sourceWS As Worksheet
    Dim destinationWS As Worksheet
    Dim sourceRange As Range
    Dim destinationRange As Range
    Dim lastRow As Long
    Dim i As Long, J As Long
    Dim destinationLastRow As Long
    Dim emptyRow As Boolean
   
    Set sourceWS = ThisWorkbook.Sheets("INDEX")
    Set destinationWS = ThisWorkbook.Sheets("INDEX2")
   
    lastRow = sourceWS.Cells(sourceWS.Rows.Count, "A").End(xlUp).Row
   
     Set sourceRange = sourceWS.Range("A3:aq" & lastRow)
   
    destinationWS.Cells.Clear

    For i = 1 To sourceRange.Rows.Count
        emptyRow = True
        For J = 1 To sourceRange.Columns.Count
            If sourceRange.Cells(i, J).Value <> "" Then 'Alex B
                emptyRow = False
                Exit For
            End If
        Next J
        If Not emptyRow Then
            If Not destinationRange Is Nothing Then
                Set destinationRange = Union(destinationRange, sourceRange.Rows(i))
            Else
                Set destinationRange = sourceRange.Rows(i)
            End If
        End If
    Next i
   
    destinationLastRow = destinationWS.Cells(destinationWS.Rows.Count, "A").End(xlUp).Row
 
    If Not destinationRange Is Nothing Then
        If destinationLastRow > 0 Then
            destinationRange.Copy destinationWS.Cells(destinationLastRow + 1, "A")
        Else
            destinationRange.Copy destinationWS.Range("A3")
        End If
    End If
destinationWS.Range("a2").EntireRow.Insert

'------------- SORTER -------------

    ' You would normally put these towards the top of the code but after > Set destinationWS = ThisWorkbook.Sheets("INDEX2")
    ' but try as is at the end first
  
Dim destinationHdgRow As Long
    With destinationWS
        destinationHdgRow = 1                                           ' <--- Change this if that is not the heading row
        destinationLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set destinationRange = .Range(.Cells(destinationHdgRow, "A"), .Cells(destinationLastRow, "aq"))
    End With
    
    ' This would be the sort after the rest of the code has finished
    destinationRange.Sort _
        Key1:=Range("A" & destinationHdgRow), Order1:=xlAscending, _
        Key2:=Range("Q" & destinationHdgRow), Order2:=xlAscending, _
        Key3:=Range("AG" & destinationHdgRow), Order3:=xlAscending, _
        Header:=xlYes
End Sub

NOTES:
I did change the Header Row to 1.
I wanted to try it as you suggested trying it at the end prior..
also, the sorting is still pasting in the top rows of INDEX2 (is there a way to shift it down and have it start on row 3? - other than adding a line shift at the end of the filter? (as you see I did (destinationWS.Range("a2").EntireRow.Insert))

ill run it again, but this time have it sort prior to running the filter

 

[Keebler]

UPDATE
so with a few changes
now i have an object required error on the same section of the VBA as in post 4
-is that not a declaration issue?
using dim statements and set did not resolve this.. so no!

Sub copy_removeblanks_sort_test_b15()

Dim lrow As Long, srow As Long, crow As Long, Irow As Long, erow As Long
Dim slist As String, sRng As String, tRng As String
Dim aWS As Worksheet, tws As Worksheet
Dim rng As Range

Set aWS = ActiveSheet
Set tws = Sheets("INDEX")

lrow = tws.Range("e1")
If lrow <= 3 Then 'checks to make sure row is at least row 3
    tRng = tws.Range("a3").Address
Else
    tRng = tws.Cells(lrow + 1, 1).Address
End If

crow = aWS.Range("e1")
srow = aWS.Range("h1")
sRng = "aq" & crow
slist = ("k" & srow & ":" & sRng)

aWS.Range(slist).Copy
tws.Range(tRng).PasteSpecial (xlPasteValues)
   
'------------- SORTER -------------

    ' You would normally put these towards the top of the code but after > Set destinationWS = ThisWorkbook.Sheets("INDEX2")
    ' but try as is at the end first
 
    Dim destinationHdgRow As Long
    Dim dWS As Worksheet, sWS As Worksheet
    Dim dRange As Range, sRange As Range
    Dim dLastRow As Long, sLastRow As Long
    Dim aRng As String, qRng As String, zRng As String
    Set sWS = ThisWorkbook.Sheets("INDEX")
    Set dWS = ThisWorkbook.Sheets("INDEX2")
      

sLastRow = sWS.Cells(sWS.Rows.Count, "A").End(xlUp).Row
   
        With sWS
        destinationHdgRow = 1                                           ' <--- Change this if that is not the heading row
        sLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set sRange = .Range(.Cells(destinationHdgRow, "A"), .Cells(sLastRow, "aq"))
    End With
 
 aRng = ("A3" & ":A" & sLastRow)
 qRng = ("Q3" & ":Q" & sLastRow)
 zRng = ("AG3" & ":AG" & sLastRow)

    ' This would be the sort after the rest of the code has finished
    destinationRange.Sort _
        Key1:=Range(aRng), Order1:=xlAscending, _
        Key2:=Range(qRng), Order2:=xlAscending, _
        Key3:=Range(zRng), Order3:=xlAscending, _
        Header:=xlNo
       
' ---------------- BLANK / EMPTY ROWS REMOVER (FILTER) ------------
'working                --------------  (by Shina67)

Application.CutCopyMode = False
Application.ScreenUpdating = True
 
    Dim sourceWS As Worksheet
    Dim destinationWS As Worksheet
    Dim sourceRange As Range
    Dim lastRow As Long
    Dim i As Long, J As Long
    Dim destinationLastRow As Long
    Dim emptyRow As Boolean
  
    Set sourceWS = ThisWorkbook.Sheets("INDEX")
    Set destinationWS = ThisWorkbook.Sheets("INDEX2")
  
    lastRow = sourceWS.Cells(sourceWS.Rows.Count, "A").End(xlUp).Row
  
     Set sourceRange = sourceWS.Range("A3:aq" & lastRow)
  
    destinationWS.Cells.Clear

    For i = 1 To sourceRange.Rows.Count
        emptyRow = True
        For J = 1 To sourceRange.Columns.Count
            If sourceRange.Cells(i, J).Value <> "" Then 'Alex B
                emptyRow = False
                Exit For
            End If
        Next J
        If Not emptyRow Then
            If Not destinationRange Is Nothing Then
                Set destinationRange = Union(destinationRange, sourceRange.Rows(i))
            Else
                Set destinationRange = sourceRange.Rows(i)
            End If
        End If
    Next i
  
    destinationLastRow = destinationWS.Cells(destinationWS.Rows.Count, "A").End(xlUp).Row
 
    If Not destinationRange Is Nothing Then
        If destinationLastRow > 0 Then
            destinationRange.Copy destinationWS.Cells(destinationLastRow + 1, "A")
        Else
            destinationRange.Copy destinationWS.Range("A3")
        End If
    End If
destinationWS.Range("a2").EntireRow.Insert


End Sub

 

[Keebler]

so fixed the object required issue
my mistake
destinationRange.Sort _
was changed to
dRange.Sort _

the error now is
the sort reference is not valid. Make sure that it is within the data you
want to sort........

the range is is exactly the data i want to sort

NOTES:
the first part of the VBA copies the formatted data to INDEX
then the sort code runs
I would prefer to sort the data before filtering it to INDEX2

    sRange.Sort _
        Key1:=Range(aRng), Order1:=xlAscending, _
        Key2:=Range(qRng), Order2:=xlAscending, _
        Key3:=Range(zRng), Order3:=xlAscending, _
        Header:=xlNo

is still giving me issues (see error at top of this post)

so, i think the answer is that the sort is NOT looking at the INDEX sheet

 

[Keebler]

okay, so i added the page reference
now the error is that all the merged cells need to be the same size

there are no merged cells on INDEX or on any other sheet in this workbook

 

[Keebler]

so, this worked...

Sub copy_removeblanks_sort_test_b30()

Dim lrow As Long, srow As Long, crow As Long, Irow As Long, erow As Long
Dim slist As String, sRng As String, tRng As String
Dim aWS As Worksheet, tws As Worksheet
Dim rng As Range

Set aWS = ActiveSheet
Set tws = Sheets("INDEX")

lrow = tws.Range("e1")
If lrow <= 3 Then 'checks to make sure row is at least row 3
    tRng = tws.Range("a3").Address
Else
    tRng = tws.Cells(lrow + 1, 1).Address
End If

crow = aWS.Range("e1")
srow = aWS.Range("h1")
sRng = "aq" & crow
slist = ("k" & srow & ":" & sRng)

aWS.Range(slist).Copy
tws.Range(tRng).PasteSpecial (xlPasteValues)
    
'------------- SORTER -------------

    ' You would normally put these towards the top of the code but after > Set destinationWS = ThisWorkbook.Sheets("INDEX2")
    ' but try as is at the end first
  
    Dim destinationHdgRow As Long
    Dim dWS As Worksheet, sWS As Worksheet
    Dim dRange As Range, sRange As Range
    Dim dLastRow As Long, sLastRow As Long
    Dim aRng As String, qRng As String, zRng As String
    Set sWS = ThisWorkbook.Sheets("INDEX")
    Set dWS = ThisWorkbook.Sheets("INDEX2")
       

sLastRow = sWS.Cells(sWS.Rows.Count, "A").End(xlUp).Row
    
        With sWS
        destinationHdgRow = 1                                           ' <--- Change this if that is not the heading row
        sLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set sRange = .Range(.Cells(destinationHdgRow, "A"), .Cells(sLastRow, "aq"))
    End With
 
 sWS.Activate
 sWS.Select
 
 aRng = ("A3" & ":A" & sLastRow)
 qRng = ("Q3" & ":Q" & sLastRow)
 zRng = ("AG3" & ":AG" & sLastRow)
    ' This would be the sort after the rest of the code has finished

sWS.Range(aRng).sort Key1:=Range("a3"), Order1:=xlAscending
'sWS.range(qRng).sort Key2:=Range("q3"), Order2:=xlAscending, _
'sWS.range(zRng).sort Key3:=Range("ag3"), Order3:=xlAscending
        
End Sub

however, there were numerous blank/empty rows at the top

 

[Keebler]

IT worked!

Sub copy_removeblanks_sort_test_b35()

Dim lrow As Long, srow As Long, crow As Long, Irow As Long, erow As Long
Dim slist As String, sRng As String, tRng As String
Dim aWS As Worksheet, tws As Worksheet
Dim rng As Range

Set aWS = ActiveSheet
Set tws = Sheets("INDEX")

lrow = tws.Range("e1")
If lrow <= 3 Then 'checks to make sure row is at least row 3
    tRng = tws.Range("a3").Address
Else
    tRng = tws.Cells(lrow + 1, 1).Address
End If

crow = aWS.Range("e1")
srow = aWS.Range("h1")
sRng = "aq" & crow
slist = ("k" & srow & ":" & sRng)

aWS.Range(slist).Copy
tws.Range(tRng).PasteSpecial (xlPasteValues)
    
'------------- SORTER -------------

    ' You would normally put these towards the top of the code but after > Set destinationWS = ThisWorkbook.Sheets("INDEX2")
    ' but try as is at the end first
  
    Dim destinationHdgRow As Long
    Dim dWS As Worksheet, sWS As Worksheet
    Dim dRange As Range, sRange As Range
    Dim dLastRow As Long, sLastRow As Long
    Dim aRng As String, qRng As String, zRng As String, fRng As String
    Set sWS = ThisWorkbook.Sheets("INDEX")
    Set dWS = ThisWorkbook.Sheets("INDEX2")
       

sLastRow = sWS.Cells(sWS.Rows.Count, "A").End(xlUp).Row
    
        With sWS
        destinationHdgRow = 1                                           ' <--- Change this if that is not the heading row
        sLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set sRange = .Range(.Cells(destinationHdgRow, "A"), .Cells(sLastRow, "aq"))
    End With
 
 sWS.Activate
 sWS.Select
 
 aRng = ("A3" & ":A" & sLastRow)
 qRng = ("Q3" & ":Q" & sLastRow)
 zRng = ("AG3" & ":AG" & sLastRow)
 fRng = ("A3" & ":Ag" & sLastRow)
    ' This would be the sort after the rest of the code has finished

sWS.Range(fRng).sort Key1:=Range("a3"), Order1:=xlAscending, _
Key2:=Range("q3"), Order2:=xlAscending, _
Key3:=Range("ag3"), Order3:=xlAscending
        
End Sub

so this leaves ALL the blanks at the top of the page (from a3 to where the data is sorted)
BUT, the first columns was sorted correctly,
but the second two were not

FLAC MASTERS 3 1 560 (version 2).xlsb
	Q
322	THE VISITORS - 04 - 100% ABBA {DISC 2} 2019 - ABBA - FMA0101 [ALBUMS]
323	THE WINNER TAKES IT ALL - 06 - 100% ABBA {DISC 1} 2019 - ABBA - FMA0101 [ALBUMS]
324	UNDER ATTACK - 13 - 100% ABBA {DISC 2} 2019 - ABBA - FMA0101 [ALBUMS]
325	VOULEZ-VOUS - 09 - 100% ABBA {DISC 1} 2019 - ABBA - FMA0101 [ALBUMS]
326	ALWAYS HAVE, ALWAYS WILL - 12 - PLAYLIST THE VERY BEST OF ACE OF BASE 2011 - ACE OF BASE - FMA0101 [ALBUMS]
327	BEATIFUL MORNING {SPANISH FLY CLUB MIX} - 22 - NEW, BEST & REMIXES 2009 - ACE OF BASE - FMA0101 [REMIXES]
328	BEAUTIFUL LIFE {JUNIOR VASQUEZ MIX} - 12 - GREATEST HITS 2000 - ACE OF BASE - FMA0101 [ALBUMS]
329	BEAUTIFUL LIFE {VISSION LORIMER CLUB MIX} - 17 - THE BRIDGE [JAPAN EDITION] 1995 - ACE OF BASE - FMA0101 [ALBUMS]
INDEX

as you see, they were sorted by the criteria in column a FIRST
(which is what i told it to do... DUH)

i need to make each sort totally independant of the the one prior

 

[Keebler]

I GOT IT!!!!!!!

after 39 tries

Sub copy_removeblanks_sort_test_b39()

Dim lrow As Long, srow As Long, crow As Long, Irow As Long, erow As Long
Dim slist As String, sRng As String, tRng As String
Dim aWS As Worksheet, tws As Worksheet
Dim rng As Range

Set aWS = ActiveSheet
Set tws = Sheets("INDEX")

lrow = tws.Range("e1")
If lrow <= 3 Then 'checks to make sure row is at least row 3
    tRng = tws.Range("a3").Address
Else
    tRng = tws.Cells(lrow + 1, 1).Address
End If

crow = aWS.Range("e1")
srow = aWS.Range("h1")
sRng = "aq" & crow
slist = ("k" & srow & ":" & sRng)

aWS.Range(slist).Copy
tws.Range(tRng).PasteSpecial (xlPasteValues)
    
'------------- SORTER -------------

    ' You would normally put these towards the top of the code but after > Set destinationWS = ThisWorkbook.Sheets("INDEX2")
    ' but try as is at the end first
  
    Dim destinationHdgRow As Long
    Dim dWS As Worksheet, sWS As Worksheet
    Dim dRange As Range, sRange As Range
    Dim dLastRow As Long, sLastRow As Long
    Dim aRng As String, qRng As String, zRng As String, fRng As String
    Set sWS = ThisWorkbook.Sheets("INDEX")
    Set dWS = ThisWorkbook.Sheets("INDEX2")
       

sLastRow = sWS.Cells(sWS.Rows.Count, "A").End(xlUp).Row
    
        With sWS
        destinationHdgRow = 1                                           ' <--- Change this if that is not the heading row
        sLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set sRange = .Range(.Cells(destinationHdgRow, "A"), .Cells(sLastRow, "aq"))
    End With
 
 sWS.Activate
 sWS.Select
 
 aRng = ("A3" & ":A" & sLastRow)
 qRng = ("Q3" & ":Q" & sLastRow)
 zRng = ("AG3" & ":AG" & sLastRow)
 fRng = ("A3" & ":AG" & sLastRow)
    ' This would be the sort after the rest of the code has finished

sWS.Range(aRng).sort Key1:=Range("a3"), Order1:=xlAscending
sWS.Range(qRng).sort Key1:=Range("q3"), Order1:=xlAscending
sWS.Range(zRng).sort Key1:=Range("ag3"), Order1:=xlAscending

        
End Sub

this sorts exactly how i wanted, BUT all the blanks are still at the top (row 3 down to where the sorted data starts)