VBA to Sort and insert blank row based on criteria

U

unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
249
Office Version
  1. 2016
Platform
  1. Windows
Hi Guys,

Can you possibly help me out on the codes that I need to use? Newbie here..
I'm aiming to work on the following:
1. Sort by descending order and separate the Zero scores.
2. Next, sort it by Confirmation and separate the N (Confirmation) and add headers as well like those with "Y".

PS: The columns might be interchangeable so might be needing to be specific on the header name (Score, Confirmation etc.)


Before code execution.....

[TABLE="class: grid, width: 450"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Sports[/TD]
[TD]Score[/TD]
[TD]Confirmation[/TD]
[/TR]
[TR]
[TD]Taylor[/TD]
[TD]Volleyball[/TD]
[TD]10[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]Ben[/TD]
[TD]Basketball[/TD]
[TD]20[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]Stephen[/TD]
[TD]Baseball[/TD]
[TD]0[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]Cara[/TD]
[TD]Volleyball[/TD]
[TD]6[/TD]
[TD]N[/TD]
[/TR]
[TR]
[TD]Emma[/TD]
[TD]Tennis[/TD]
[TD]4[/TD]
[TD]N[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

After code execution:

[TABLE="class: grid, width: 450"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Sports[/TD]
[TD]Score[/TD]
[TD]Confirmation[/TD]
[/TR]
[TR]
[TD]Ben[/TD]
[TD]Baskell[/TD]
[TD]20[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]Taylor[/TD]
[TD]Volleyball[/TD]
[TD]10[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]UNCONFIRMED[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Name[/TD]
[TD]Sports[/TD]
[TD]Score[/TD]
[TD]Confirmation[/TD]
[/TR]
[TR]
[TD]Cara[/TD]
[TD]Volleyball[/TD]
[TD]6[/TD]
[TD]N[/TD]
[/TR]
[TR]
[TD]Emma[/TD]
[TD]Tennis[/TD]
[TD]4[/TD]
[TD]N[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ZERO SCORE[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Stephen[/TD]
[TD]Baseball[/TD]
[TD]0[/TD]
[TD]Y[/TD]
[/TR]
</tbody>[/TABLE]



Any help will be much appreciated...:)
 
Sort by date Sort by votes
Hi Fluff,

See below just consider there's a table for this. I've put "Score" next to "Name" and added new columns like Time, QTY, DAY and Game.
The column positions might differ sometimes but I'm using the same column name.


Name Score Sports Event Time QTY Confirmation DAY Game
Taylor 15 Volleyball 1 20m - Y 1 Morning
Cara 6 Volleyball 2 25m - N 1 Morning
Emma 4 Tennis 5 35m - N 2 Evening
Ben 10 Basketball 3 46m - Y 3 Evening
Step (blank) Baseball 4 26m - Y 4 Morning

Thanks again!
 
Last edited:
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Score[/TD]
[TD]Sports[/TD]
[TD]Event[/TD]
[TD]Time[/TD]
[TD]QTY[/TD]
[TD]Confirmation[/TD]
[TD]Day[/TD]
[TD]Game[/TD]
[/TR]
[TR]
[TD]Taylor[/TD]
[TD]10[/TD]
[TD]Volleyball[/TD]
[TD]1[/TD]
[TD]26m[/TD]
[TD]-[/TD]
[TD]Y[/TD]
[TD]1[/TD]
[TD]MORNING[/TD]
[/TR]
[TR]
[TD]Cara[/TD]
[TD]16[/TD]
[TD]Volleball[/TD]
[TD]1[/TD]
[TD]39m[/TD]
[TD]-[/TD]
[TD]N[/TD]
[TD]1[/TD]
[TD]EVENING[/TD]
[/TR]
[TR]
[TD]Emma[/TD]
[TD]4[/TD]
[TD]Tennis[/TD]
[TD]2[/TD]
[TD]46m[/TD]
[TD]-[/TD]
[TD]Y[/TD]
[TD]2[/TD]
[TD]EVENING[/TD]
[/TR]
[TR]
[TD]Steph[/TD]
[TD][/TD]
[TD]Baseball[/TD]
[TD]2[/TD]
[TD]35m[/TD]
[TD]-[/TD]
[TD]Y[/TD]
[TD]2[/TD]
[TD]MORNING[/TD]
[/TR]
[TR]
[TD]Ben[/TD]
[TD]26[/TD]
[TD]Baskeball[/TD]
[TD]3[/TD]
[TD]58m[/TD]
[TD]-[/TD]
[TD]Y[/TD]
[TD]3[/TD]
[TD]EVENING[/TD]
[/TR]
[TR]
[TD]Ron[/TD]
[TD]16[/TD]
[TD]Baskeball[/TD]
[TD]3[/TD]
[TD]43m[/TD]
[TD]-[/TD]
[TD]Y[/TD]
[TD]3[/TD]
[TD]MORNING[/TD]
[/TR]
</tbody>[/TABLE]

Kindly use this table instead...thank you!
 
Upvote 0
This should work for the table above.
Code: 
Sub Two_Rows_v2()
    Dim FoundRow As Long
    Dim BreakData As Variant
    Dim i As Long
    Dim ScCol As Range
    Dim CoCol As Range
    
    Const BreakInfo As String = "|Zero Score|N|Unconfirmed" '<- Add more pairs here if you want
Application.ScreenUpdating = False
    
    Set ScCol = Rows(1).Find("Score", Range("A1"), , xlWhole, , , False, False)
    Set CoCol = Rows(1).Find("Confirmation", Range("A1"), , xlWhole, , , False, False)
    With ActiveSheet
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Columns(CoCol.column), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Columns(ScCol.column), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A:Z")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    BreakData = Split(BreakInfo, "|")
    For i = 0 To UBound(BreakData) Step 2
      FoundRow = 0
      On Error Resume Next
      FoundRow = Columns(ScCol.column).Resize(, 7).Find(what:=BreakData(i), LookIn:=xlValues, LookAt:=xlWhole, SearchFormat:=False).Row
      On Error GoTo 0
      If FoundRow > 0 Then
        Rows(FoundRow).Resize(2).Insert
        Cells(FoundRow + 1, 1).Value = BreakData(i + 1)
      End If
    Next i
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hello,

I was working on some modifications on the macro that I created initially. I have below data which I need to group based on Status.

Before:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Status[/TD]
[TD]Name[/TD]
[TD]Score[/TD]
[/TR]
[TR]
[TD]Current[/TD]
[TD]Ana[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]NotIncluded[/TD]
[TD]Susan[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]Zero[/TD]
[TD]Ben[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]NotConfirmed[/TD]
[TD]Sean[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]Current[/TD]
[TD]Flor[/TD]
[TD]30[/TD]
[/TR]
</tbody>[/TABLE]

With Code: In order = Current > Unconfirmed >Not Included > Zero

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Status[/TD]
[TD]Name[/TD]
[TD]Score[/TD]
[/TR]
[TR]
[TD]Current[/TD]
[TD]Flor[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]Current[/TD]
[TD]Ana[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]UNCONFIRMED[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Status[/TD]
[TD]Name[/TD]
[TD]Score[/TD]
[/TR]
[TR]
[TD]NotConfirmed[/TD]
[TD]Sean[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]NOT INCLUDED[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Status[/TD]
[TD]Name[/TD]
[TD]Score[/TD]
[/TR]
[TR]
[TD]NotIncluded[/TD]
[TD]Susan[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]NO SCORE[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Status[/TD]
[TD]Name [/TD]
[TD]Score[/TD]
[/TR]
[TR]
[TD]Zero[/TD]
[TD]Ben[/TD]
[TD]0[/TD]
[/TR]
</tbody>[/TABLE]

*Each group must be sorted based on Name


Thanks in advance for all you help.
 
Upvote 0
Code: 
Sub Two_Rows_v2()
    Dim FoundRow As Long
    Dim BreakData As Variant
    Dim i As Long
    Dim ScCol As Range
    Dim CoCol As Range
    
    Const BreakInfo As String = "NotConfirmed|Unconfirmed|notIncluded|Not Included|Zero|No Score" '<- Add more pairs here if you want
Application.ScreenUpdating = False
    
    Set ScCol = Rows(1).Find("Status", Range("A1"), , xlWhole, , , False, False)
    With ActiveSheet
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Columns(ScCol.Column), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A:Z")
            .header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    BreakData = Split(BreakInfo, "|")
    For i = 0 To UBound(BreakData) Step 2
      FoundRow = 0
      On Error Resume Next
      FoundRow = Columns(ScCol.Column).Resize(, 3).Find(what:=BreakData(i), LookIn:=xlValues, LookAt:=xlWhole, SearchFormat:=False).Row
      On Error GoTo 0
      If FoundRow > 0 Then
        Rows(FoundRow).Resize(2).Insert
        Cells(FoundRow + 1, 1).Value = BreakData(i + 1)
      End If
    Next i
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
This is awesome Fluff!! This works well however the header for each group is missing - Status, Name & Score. Thanks again :)
 
Upvote 0
Ok, try this
Code: 
Sub Two_Rows_v2()
    Dim FoundRow As Long
    Dim BreakData As Variant
    Dim i As Long
    Dim ScCol As Range
    Dim CoCol As Range
    
    Const BreakInfo As String = "NotConfirmed|Unconfirmed|notIncluded|Not Included|Zero|No Score" '<- Add more pairs here if you want
Application.ScreenUpdating = False
    
    Set ScCol = Rows(1).Find("Status", Range("A1"), , xlWhole, , , False, False)
    With ActiveSheet
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Columns(ScCol.Column), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A:Z")
            .header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    BreakData = Split(BreakInfo, "|")
    For i = 0 To UBound(BreakData) Step 2
      FoundRow = 0
      On Error Resume Next
      FoundRow = Columns(ScCol.Column).Resize(, 3).Find(what:=BreakData(i), LookIn:=xlValues, LookAt:=xlWhole, SearchFormat:=False).Row
      On Error GoTo 0
      If FoundRow > 0 Then
        Rows(FoundRow).Resize(3).Insert
        Cells(FoundRow + 1, 1).Value = BreakData(i + 1)
        Range("A1:C1").Copy Range("A" & FoundRow + 2)
      End If
    Next i
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
VBA code to cut and paste multiple filtered rows based on multiple criteria
Replies
2
Views
1K
Alex Blakenburg
A
V
  • Question Question
VBA Code Help. Need to cut/paste rows to different sheets based on different criteria & sort by date
2
Replies
10
Views
1K
psgoldberg
P
Burrgogi
  • Question Question
VBA sorting problem and moving rows based on criteria
Replies
5
Views
1K
Burrgogi
Burrgogi
C
  • Solved
Help with this custom sort and insert blank rows macro?
2 3
Replies
21
Views
920
Coyotex3
C
R
  • Question Question
Writing VBA macro for generating missing variable
2
Replies
11
Views
1K
ryan8200
R

Forum statistics

Threads
1,224,940
Messages
6,181,890
Members
453,068
Latest member
DCD1872

Share this page

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