VBA in Microsoft Excel Version 365

[lcoleman1412]

My boss would like me to insert a button in cell C25. He wants to be able to click the button and be able to sort the data. When I tried to create and insert a button I plugged in a VBA code and it sorted it but it would move all of my data up. I need to be able to sort it while leaving rows 1, 2, 6,16 ,22, 23 with the headings, #'s 1,2,3,4, and CDT-Recall-8 in the same place. Could anyone please help me with a code that can sort the data on the sheet and be able to sort any new data inserted without moving those certain cells? My boss said he wants column B and C to sort and column C to be the key.



The first two images I have uploaded are images of my excel sheet. The last image is how my excel sheet turned out after I tried the VBA code.

 

[Sam_D_Ben]

Give it a go,

Sub x1()
    Dim a As Worksheet
    Dim b As Long, c As Long, d As Long, e As Long

    Set a = ActiveSheet
    b = a.Cells(a.Rows.Count, "B").End(xlUp).Row
    c = 2

    Do While c <= b
        If IsNumeric(a.Cells(c, 1).Value) And a.Cells(c, 1).Value <> "" Then
            d = c + 1
            e = d

            Do While e <= b And a.Cells(e, 1).Value = ""
                e = e + 1
            Loop
            e = e - 1

            If e > d Then
                a.Sort.SortFields.Clear
                a.Sort.SortFields.Add Key:=a.Range("C" & d & ":C" & e), _
                    SortOn:=xlSortOnValues, Order:=xlAscending, _
                    DataOption:=xlSortNormal

                With a.Sort
                    .SetRange a.Range("B" & d & ":C" & e)
                    .Header = xlNo
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End If
            c = e + 1
        Else
            c = c + 1
        End If
    Loop
    
End Sub

 

[fahad_ibnfurjan]

Sub Mysort()
Dim Arr As String, Arr1 As String
Dim Rng As Range
    For Each Rng In Worksheets(4).Range("A2:A23")
        If Rng.Value <> "" Then
            With Rng
                Arr = .Offset(1, 1).Address
                Arr1 = .Offset(1, 1).Offset(0, 1).Address
                    If .Offset(1, 1).End(xlDown).Row < 5000 Then
                        Arr = Arr & ":" & .Offset(1, 1).End(xlDown).Offset(0, 1).Address
                        Arr1 = Arr1 & ":" & .Offset(1, 1).End(xlDown).Offset(0, 1).Address
                    Else
                        Arr = Arr & ":" & .Cells(.Rows.Count, 3).Offset(0, 1).End(xlDown).Address
                        Arr1 = Arr1 & ":" & .Cells(.Rows.Count, 3).Offset(0, 1).End(xlDown).Address
                    End If
            End With
            With Worksheets("G")
                With .Sort
                        .SortFields.Add2 Key:=Range(Arr1), _
                         SortOn:=xlSortOnValues, Order:=xlAscending, _
                         DataOption:=xlSortNormal
                        .SetRange Range(Arr)
                        .Header = xlGuess
                        .MatchCase = False
                        .Orientation = xlTopToBottom
                        .SortMethod = xlPinYin
                        .Apply
                End With
            End With
        End If
    Next
End Sub

 

[fahad_ibnfurjan]

Sub Mysort()
Dim Arr As String, Arr1 As String
Dim Rng As Range
    For Each Rng In Worksheets("Sheet 3 (Sort)").Range("A2:A23")
        If Rng.Value <> "" Then
            With Rng
                Arr = .Offset(1, 1).Address
                Arr1 = .Offset(1, 1).Offset(0, 1).Address
                    If .Offset(1, 1).End(xlDown).Row < 5000 Then
                        Arr = Arr & ":" & .Offset(1, 1).End(xlDown).Offset(0, 1).Address
                        Arr1 = Arr1 & ":" & .Offset(1, 1).End(xlDown).Offset(0, 1).Address
                    Else
                        Arr = Arr & ":" & .Cells(.Rows.Count, 3).Offset(0, 1).End(xlDown).Address
                        Arr1 = Arr1 & ":" & .Cells(.Rows.Count, 3).Offset(0, 1).End(xlDown).Address
                    End If
            End With
            With Worksheets("Sheet 3 (Sort)")
                With .Sort
                        .SortFields.Add2 Key:=Range(Arr1), _
                         SortOn:=xlSortOnValues, Order:=xlAscending, _
                         DataOption:=xlSortNormal
                        .SetRange Range(Arr)
                        .Header = xlGuess
                        .MatchCase = False
                        .Orientation = xlTopToBottom
                        .SortMethod = xlPinYin
                        .Apply
                End With
            End With
        End If
    Next
End Sub

Rename worksheet to Worksheets("Sheet 3 (Sort)")

 

[Fuji]

lcoleman1412
You have more digits in col.C after sort.
Does it need to be considered?

Sub test()
    Dim x&, r As Range
    With Sheets("sheet 3 (sort)")
        x = .Evaluate(Replace("max(if(isnumber(#),row(#)))", "#", .UsedRange.Columns(3).Address))
        On Error Resume Next
        For Each r In .Range("b1:b" & x).SpecialCells(4)
            r(2, 0) = r(1, 0)
        Next
        .Range("b1:b" & x).SpecialCells(4).EntireRow.Delete
        With .Range("b2", .Range("b" & Rows.Count).End(xlUp)).Resize(, 2)
            .Sort .Columns(2)
        End With
    End With
End Sub

 

[fahad_ibnfurjan]

Option

Sort sort.xlsm
	A	B	C	D	E	F
1	Stage/Phase
2	1
3		CDT-Procedure1	1.1		CDT-Procedure1	1.1
4		CDT-Procedure2	2.1		CDT-Procedure2	2.1
5		CDT-Procedure3	3.1		CDT-Procedure3	3.1
6	2
7		CDT-Procedure1	2.2		CDT-Procedure2	1.1
8		CDT-Procedure2	1.1		CDT-Procedure3	2.1
9		CDT-Procedure3	2.1		CDT-Procedure1	2.2
10		CDT-Procedure4	4.3		CDT-Procedure7	2.3
11		CDT-Procedure5	4.1		CDT-Procedure9	3.1
12		CDT-Procedure6	4.2		CDT-Procedure8	3.2
13		CDT-Procedure7	2.3		CDT-Procedure5	4.1
14		CDT-Procedure8	3.2		CDT-Procedure6	4.2
15		CDT-Procedure9	3.1		CDT-Procedure4	4.3
16	3
17		CDT-Procedure1	2.3		CDT-Procedure5	1.1
18		CDT-Procedure2	2.1		CDT-Procedure3	1.2
19		CDT-Procedure3	1.2		CDT-Procedure2	2.1
20		CDT-Procedure4	2.2		CDT-Procedure4	2.2
21		CDT-Procedure5	1.1		CDT-Procedure1	2.3
22	4
23		CDT-Recall	4.1		CDT-Recall	4.1
24	5
S

Cell Formulas
Range	Formula
E2:F23	E2	=SORTBY(B2:C23,C2:C23+LET(X,A2:A24,Y,TEXTJOIN("",0,IFERROR(REPT(","&ROW(1:5),UNIQUE(MATCH(A3:A24,A3:A24),0,1)+1-UNIQUE(MATCH(X,X),0,1)),"")),MID(Y,FIND("|",SUBSTITUTE(Y,",","|",ROW(1:22)))+1,1)*100))
Dynamic array formulas.