VBA to Sort and insert blank row based on criteria

[unknownymous]

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.....

Name	Sports	Score	Confirmation
Taylor	Volleyball	10	Y
Ben	Basketball	20	Y
Stephen	Baseball	0	Y
Cara	Volleyball	6	N
Emma	Tennis	4	N

<tbody>
</tbody>

After code execution:

Name	Sports	Score	Confirmation
Ben	Baskell	20	Y
Taylor	Volleyball	10	Y
UNCONFIRMED
Name	Sports	Score	Confirmation
Cara	Volleyball	6	N
Emma	Tennis	4	N
ZERO SCORE
Stephen	Baseball	0	Y

<tbody>
</tbody>

Any help will be much appreciated...

 

[unknownymous]

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!

 

[unknownymous]

Name	Score	Sports	Event	Time	QTY	Confirmation	Day	Game
Taylor	10	Volleyball	1	26m	-	Y	1	MORNING
Cara	16	Volleball	1	39m	-	N	1	EVENING
Emma	4	Tennis	2	46m	-	Y	2	EVENING
Steph		Baseball	2	35m	-	Y	2	MORNING
Ben	26	Baskeball	3	58m	-	Y	3	EVENING
Ron	16	Baskeball	3	43m	-	Y	3	MORNING

<tbody>
</tbody>

Kindly use this table instead...thank you!

 

[Fluff]

This should work for the table above.

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

 

[unknownymous]

Its working! Thanks again!!

 

[Fluff]

You're welcome

 

[unknownymous]

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:

Status	Name	Score
Current	Ana	10
NotIncluded	Susan	20
Zero	Ben	0
NotConfirmed	Sean	5
Current	Flor	30

<tbody>
</tbody>

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

Status	Name	Score
Current	Flor	30
Current	Ana	10
UNCONFIRMED
Status	Name	Score
NotConfirmed	Sean	5
NOT INCLUDED
Status	Name	Score
NotIncluded	Susan	20
NO SCORE
Status	Name	Score
Zero	Ben	0

<tbody>
</tbody>

*Each group must be sorted based on Name


Thanks in advance for all you help.

 

[Fluff]

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

 

[unknownymous]

This is awesome Fluff!! This works well however the header for each group is missing - Status, Name & Score. Thanks again

 

[Fluff]

Ok, try this

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

 

[unknownymous]

Amazing!! Thank you Fluff and happy New year!!!