Need ActiveSheet table sorting help...

Nuke_It_Newport

New Member
Joined
Nov 17, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
Good morning everyone-

I need some help sorting tables in the following order. I need to perform this sort on any worksheet in the workbook. All the sheets have the same table with headers, same column names, different table names.

First sort is as follows:
Operating Area (Ascending)​
Activity (Ascending)​
Job Plan (Ascending)​
Actual Finish (Ascending)​
Work Order (Ascending)​

Second sort is as follows:
Work Order (RGB(0, 0, 0) "Black"​
Work Order RGB(255, 102, 0) "Orange"​
Work Order RGB(0, 128, 0) "Green"
Work Order RGB(255, 0, 0) "Red"​

I have the following code, and it sorts correctly on the table referenced in the code, but I don't know how to rewrite it to sort on the active sheet's table.

VBA Code:
Option Explicit

Sub SortImport()

Dim wb As Workbook
Dim ws As Worksheet
Dim listObj As ListObject

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet
Set listObj = wb.Worksheets("Import").ListObjects("tblImport")

With wb
    .Worksheets("Import").ListObjects("tblImport").Sort.SortFields. _
            Clear
    With listObj.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("tblImport[Operating Area]"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("tblImport[Activity]"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("tblImport[Job Plan]"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("tblImport[Actual Finish]"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("tblImport[Work Order]"), SortOn:=xlSortOnValues, Order:=xlAscending
        .Header = xlYes
        .Apply
    End With
    
    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    
    .Worksheets("Import").ListObjects("tblImport").Sort.SortFields. _
            Add(Range("tblImport[[#All],[Work Order]]"), xlSortOnFontColor, xlAscending, , _
            xlSortNormal).SortOnValue.Color = RGB(0, 0, 0)
        With .Worksheets("Import").ListObjects("tblImport").Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .Worksheets("Import").ListObjects("tblImport").Sort.SortFields. _
            Clear
        .Worksheets("Import").ListObjects("tblImport").Sort.SortFields. _
            Add(Range("tblImport[[#All],[Work Order]]"), xlSortOnFontColor, xlAscending, , _
            xlSortNormal).SortOnValue.Color = RGB(255, 102, 0)
        With .Worksheets("Import").ListObjects("tblImport").Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
      .Worksheets("Import").ListObjects("tblImport").Sort.SortFields. _
            Clear
        .Worksheets("Import").ListObjects("tblImport").Sort.SortFields. _
            Add(Range("tblImport[[#All],[Work Order]]"), xlSortOnFontColor, xlAscending, , _
            xlSortNormal).SortOnValue.Color = RGB(0, 128, 0)
        With .Worksheets("Import").ListObjects("tblImport").Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .Worksheets("Import").ListObjects("tblImport").Sort.SortFields. _
            Clear
        .Worksheets("Import").ListObjects("tblImport").Sort.SortFields. _
            Add(Range("tblImport[[#All],[Work Order]]"), xlSortOnFontColor, xlAscending, , _
            xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
        With .Worksheets("Import").ListObjects("tblImport").Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
End With

End Sub

I have changed this line:
Code:
Set listObj = wb.Worksheets("Import").ListObjects("tblImport")
To this:
Code:
Set listObj = ws.ListObjects(1)
This references the table correctly.

I can't figure out how to change the following lines to reference the active sheet's table, instead of "tblImport".
Code:
With listObj.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("tblImport[Operating Area]"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("tblImport[Activity]"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("tblImport[Job Plan]"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("tblImport[Actual Finish]"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("tblImport[Work Order]"), SortOn:=xlSortOnValues, Order:=xlAscending
        .Header = xlYes
        .Apply
    End With

On another note, I read somewhere that it's not a preferred method to sort based on font color, but to sort on a helper column instead. I will change this once I get my current issue resolved.
Thanks!

Chad
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Hi @Nuke_It_Newport. Thanks for posting on the forum!

I updated the name of the listbox
Range("tblImport[Operating Area]")

With this option:
Range(listObj.Name & "[Operating Area]")

I also adjusted the other lines of the code to sort by colors ;)

Try this:

VBA Code:
Sub SortImport()
  Dim wb As Workbook
  Dim ws As Worksheet
  Dim listObj As ListObject
  Dim wOrder As Range
  
  Set wb = ThisWorkbook
  Set ws = wb.ActiveSheet
  Set listObj = wb.Worksheets("Import").ListObjects("tblImport")
  
  With listObj.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range(listObj.Name & "[Operating Area]"), SortOn:=xlSortOnValues, Order:=xlAscending
    .SortFields.Add Key:=Range(listObj.Name & "[Activity]"), SortOn:=xlSortOnValues, Order:=xlAscending
    .SortFields.Add Key:=Range(listObj.Name & "[Job Plan]"), SortOn:=xlSortOnValues, Order:=xlAscending
    .SortFields.Add Key:=Range(listObj.Name & "[Actual Finish]"), SortOn:=xlSortOnValues, Order:=xlAscending
    .SortFields.Add Key:=Range(listObj.Name & "[Work Order]"), SortOn:=xlSortOnValues, Order:=xlAscending
    .Header = xlYes
    .Apply
  End With

  With listObj.Sort
    .SortFields.Clear
    Set wOrder = Range(listObj.Name & "[[#All],[Work Order]]")
    .SortFields.Add(wOrder, xlSortOnCellColor, xlAscending, , xlSortTextAsNumbers).SortOnValue.Color = RGB(0, 0, 0)
    .SortFields.Add(wOrder, xlSortOnCellColor, xlAscending, , xlSortTextAsNumbers).SortOnValue.Color = RGB(255, 102, 0)
    .SortFields.Add(wOrder, xlSortOnCellColor, xlAscending, , xlSortTextAsNumbers).SortOnValue.Color = RGB(0, 128, 0)
    .SortFields.Add(wOrder, xlSortOnCellColor, xlAscending, , xlSortTextAsNumbers).SortOnValue.Color = RGB(255, 0, 0)
    .Header = xlYes
    .Apply
  End With
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------
 
Last edited:
Upvote 0
Solution
Hi @Nuke_It_Newport. Thanks for posting on the forum!

I updated the name of the listbox
Range("tblImport[Operating Area]")

With this option:
Range(listObj.Name & "[Operating Area]")

I also adjusted the other lines of the code to sort by colors ;)

Try this:

VBA Code:
Sub SortImport()
  Dim wb As Workbook
  Dim ws As Worksheet
  Dim listObj As ListObject
  Dim wOrder As Range
 
  Set wb = ThisWorkbook
  Set ws = wb.ActiveSheet
  Set listObj = wb.Worksheets("Import").ListObjects("tblImport")
 
  With listObj.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range(listObj.Name & "[Operating Area]"), SortOn:=xlSortOnValues, Order:=xlAscending
    .SortFields.Add Key:=Range(listObj.Name & "[Activity]"), SortOn:=xlSortOnValues, Order:=xlAscending
    .SortFields.Add Key:=Range(listObj.Name & "[Job Plan]"), SortOn:=xlSortOnValues, Order:=xlAscending
    .SortFields.Add Key:=Range(listObj.Name & "[Actual Finish]"), SortOn:=xlSortOnValues, Order:=xlAscending
    .SortFields.Add Key:=Range(listObj.Name & "[Work Order]"), SortOn:=xlSortOnValues, Order:=xlAscending
    .Header = xlYes
    .Apply
  End With

  With listObj.Sort
    .SortFields.Clear
    Set wOrder = Range(listObj.Name & "[[#All],[Work Order]]")
    .SortFields.Add(wOrder, xlSortOnCellColor, xlAscending, , xlSortTextAsNumbers).SortOnValue.Color = RGB(0, 0, 0)
    .SortFields.Add(wOrder, xlSortOnCellColor, xlAscending, , xlSortTextAsNumbers).SortOnValue.Color = RGB(255, 102, 0)
    .SortFields.Add(wOrder, xlSortOnCellColor, xlAscending, , xlSortTextAsNumbers).SortOnValue.Color = RGB(0, 128, 0)
    .SortFields.Add(wOrder, xlSortOnCellColor, xlAscending, , xlSortTextAsNumbers).SortOnValue.Color = RGB(255, 0, 0)
    .Header = xlYes
    .Apply
  End With
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------
That works perfectly. Thank you for your help!

Chad
 
Upvote 1

Forum statistics

Threads
1,214,851
Messages
6,121,931
Members
449,056
Latest member
denissimo

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