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

Keebler

Board Regular
Joined
Dec 1, 2021
Messages
176
Office Version
  1. 2021
Platform
  1. Windows
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

VBA Code:
        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
 
so, here is the WORKING VBA
Thank you Alex B for getting me on the correct path...
this VBA does it all.. copies, sorts and removes blank rows :)


VBA Code:
Sub copy_removeblanks_sort_test_b40()

Dim lrow As Long, srow As Long, crow 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, eRow As Long
    Dim aRng As String, qRng As String, zRng As String, fRng As String, eRng As String
    Set sWS = ThisWorkbook.Sheets("INDEX")
    Set dWS = ThisWorkbook.Sheets("INDEX2")
       

sLastRow = sWS.Cells(sWS.Rows.Count, "A").End(xlUp).Row
eRow = sWS.Range("h1")
    
        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)
 eRng = ("A3" & ":A" & eRow)
 
    ' 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

Range(eRng).EntireRow.Delete

End Sub

thank you:)
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
You're welcome. Glad we could help.

Thanks for posting what you finished up with.
You have made a lot of changes and I am a bit suprised that when you said sort separately you really meant totally separately.
Typically a row is a "record" which means all the columns in that row are related and need to stay together. The latest code sorts them as stand alone columns sorting just those columns and not the rest of the row with it. I assume that was your intention.
 
Upvote 0
Thank you Alex B.
yeah, I try very hard to be as detailed and specific as I can with what I am tying to do. I find that is the best way to get the best information. especially in an environment like this. where it is very difficult to covey sometimes the full intent of a thought process.

I really am trying to learn... not just the solutions. but, WHY they work.

as you saw, i try to post how I am solving each thing, so when I mess up. i hope that it makes it easier for someone much smarter than i am to help me get back on track.

thank you again Alex B. :)
🍺

post
I will probably clean the VBA up, so it not so difficult to follow.

I have made a personal codebook (it is built in to excel)
that way all the working VBA is ready for whatever workbook I am working on
 
Upvote 0

Forum statistics

Threads
1,224,809
Messages
6,181,075
Members
453,020
Latest member
mattg2448

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top