VBA Help - Sorting Data Table

[Johnny Thunder]

Hello All,

I am working on a table of data that I will need to sort by the "Object" Column. The goal is to have a button that the user can trigger that will loop thru the data and find any new values and sort the data accordingly and also put a under line border on the last unique value of each group of values.

Any help is always appreciated!

Here is a sample of unsorted data as the user populates the table -

Budget Log V1.0.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Daily Log
2
3	Row Count	Object	Date Rec'D	Budget Reviewed By	Date Reviewed	Notes Given/ Approved	Currency	Budget Net/ Ep	Total Gross Budget	Less Est.Tax Incentives	Budget Adj	Total Net Budget	Changes From Last Draft	Arrows	Comments
4	1	Orange	9/6/20	Billy	9/21/20		USD	500	700			575	550	?
5	2	Apple	9/11/20	Billy	9/26/20		USD	650	850			725	700	?
6	3	Apple	9/16/20	Billy	10/1/20		USD	800	1,000			875	850	?
7	5	Pear	9/26/20	Billy	10/11/20		USD	1,100	1,300			1,175	1,150	?
8	6	Banana	10/1/20	Billy	10/16/20		USD	1,250	1,450			1,325	1,300	?
9	7	Pear	10/6/20	Billy	10/21/20		USD	1,400	1,600			1,475	1,450	?
10	8	Banana	10/11/20	Billy	10/26/20		USD	1,550	1,750			1,625	1,600	?
Test

And here is a sample after the data has been manipulated by a macro (hopefully) -

Budget Log V1.0.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
16	Daily Log
17
18	Row Count	Object	Date Rec'D	Budget Reviewed By	Date Reviewed	Notes Given/ Approved	Currency	Budget Net/ Ep	Total Gross Budget	Less Est.Tax Incentives	Budget Adj	Total Net Budget	Changes From Last Draft	Arrows	Comments
19	1	Apple	9/11/20	Billy	9/26/20		USD	650	850			725	700	?
20	2	Apple	9/16/20	Billy	10/1/20		USD	800	1,000			875	850	?
21	3	Banana	10/1/20	Billy	10/16/20		USD	1,250	1,450			1,325	1,300	?
22	4	Banana	10/11/20	Billy	10/26/20		USD	1,550	1,750			1,625	1,600	?
23	5	Orange	9/6/20	Billy	9/21/20		USD	500	700			575	550	?
24	7	Pear	9/26/20	Billy	10/11/20		USD	1,100	1,300			1,175	1,150	?
25	8	Pear	10/6/20	Billy	10/21/20		USD	1,400	1,600			1,475	1,450	?
Test

 

[Ezguy4u]

Let's get the ball rolling. If you have any questions let us know. Maybe some of thee A Students will weigh in and shorten the program.

Sub Sort1()
Dim LastRow As Long
Sheets("Sort Obj").Select

LastRow = Cells(Rows.Count, "B").End(xlUp).Row

Range((Cells(3, 1)), (Cells(LastRow, 15))).Select
    ActiveWorkbook.Worksheets("Sort Obj").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sort Obj").Sort.SortFields.Add2 Key:=Range((Cells(4, 2)), (Cells(LastRow, 2))) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sort Obj").Sort
        .SetRange Range((Cells(3, 1)), (Cells(LastRow, 15)))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B2").Select
    
 For row1 = 4 To LastRow
    
 If Cells(row1, 2) <> Cells(row1 + 1, 2) Then
    Range((Cells(row1, 1)), (Cells(row1, 15))).Select

    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
End If

Next row1
Range("A1").Select

End Sub

20-09-21 Sort Object.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Daily Log
2
3	Row Count	Object	Date Rec'D	Budget Reviewed By	Date Reviewed	Notes Given/ Approved	Currency	Budget Net/ Ep	Total Gross Budget	Less Est.Tax Incentives	Budget Adj	Total Net Budget	Changes From Last Draft	Arrows	Comments
4	1	Orange	9/6/2020	Billy	9/21/2020		USD	500	700			575	550	?
5	2	Apple	9/11/2020	Billy	9/26/2020		USD	650	850			725	700	?
6	3	Apple	9/16/2020	Billy	10/1/2020		USD	800	1000			875	850	?
7	5	Pear	9/26/2020	Billy	10/11/2020		USD	1100	1300			1175	1150	?
8	6	Banana	10/1/2020	Billy	10/16/2020		USD	1250	1450			1325	1300	?
9	7	Pear	10/6/2020	Billy	10/21/2020		USD	1400	1600			1475	1450	?
10	8	Banana	10/11/2020	Billy	10/26/2020		USD	1550	1750			1625	1600	?
Sort Obj

 

[Johnny Thunder]

Thank you for the help on this. Will be giving this a shot shortly. I will update on how it works for my project.

 

[Dossfm0q]

Count

=IF(B4<>"",ROWS($A4:A$4),"")

in Worksheet module

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sht As Worksheet
Set Sht = ThisWorkbook.Worksheets("Sort Obj")

    With Sht
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range("B4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A4:O20")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

End Sub

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Daily Log
2
3	Row Count	Object	Date Rec'D	Budget Reviewed By	Date Reviewed	Notes Given/ Approved	Currency	Budget Net/ Ep	Total Gross Budget	Less Est.Tax Incentives	Budget Adj	Total Net Budget	Changes From Last Draft	Arrows	Comments
4	1	Apple	9/11/2020	Billy	9/26/2020		USD	650	850			725	700	?
5	2	Apple	9/16/2020	Billy	10/1/2020		USD	800	1000			875	850	?
6	3	Banana	10/1/2020	Billy	10/16/2020		USD	1250	1450			1325	1300	?
7	4	Banana	10/11/2020	Billy	10/26/2020		USD	1550	1750			1625	1600	?
8	5	Orange	9/6/2020	Billy	9/21/2020		USD	500	700			575	550	?
9	6	Pear	9/26/2020	Billy	10/11/2020		USD	1100	1300			1175	1150	?
10	7	Pear	10/6/2020	Billy	10/21/2020		USD	1400	1600			1475	1450	?
Sort Obj

Cell Formulas
Range	Formula
A9:A10,A4:A7	A4	=IF(B4<>"",ROWS($A$4:A4),"")
A8	A8	=IF(B8<>"",ROWS($A4:A$8),"")