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

 

[Fluff]

Try this slight tweak to the code that @Peter_SSs supplied here
https://www.mrexcel.com/forum/excel...-two-rows-when-condition-met.html#post4916446

Sub Two_Rows_v2()
  Dim FoundRow As Long
  Dim BreakData As Variant
  Dim i As Long
  
  Const BreakInfo As String = "0|Zero Score|N|Unconfirmed" '<- Add more pairs here if you want
  
  BreakData = Split(BreakInfo, "|")
  Application.ScreenUpdating = False
  For i = 0 To UBound(BreakData) Step 2
    FoundRow = 0
    On Error Resume Next
    FoundRow = Columns("C").Resize(, 2).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

 

[Fluff]

Forgot the bit about column order.
Back in a mo

 

[Fluff]

Try

Sub Two_Rows_v2()
    Dim FoundRow As Long
    Dim BreakData As Variant
    Dim i As Long
    Dim Fnd As Range
    
    Const BreakInfo As String = "0|Zero Score|N|Unconfirmed" '<- Add more pairs here if you want
Application.ScreenUpdating = False
    
    Set Fnd = Rows(1).Find("Score", Range("A1"), , xlWhole, , , False, False)
    If Fnd.Column = 4 Then
        Columns(Fnd.Column).Cut
        Fnd.Offset(, -1).Insert
    End If
    
    With ActiveSheet
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A:D")
            .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("C").Resize(, 2).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 flawless!!! Thank you very much :wink:

 

[Fluff]

Glad to help & thanks for the feedback

 

[unknownymous]

One more thing as I forgot to mention it, what if there's a blank score and I want to put it under the "UNCONFIRMED" section. What's the code for that? Thanks again.

 

[Fluff]

How about

Sub Two_Rows_v2()
    Dim FoundRow As Long
    Dim BreakData As Variant
    Dim i As Long
    Dim Fnd As Range
    
    Const BreakInfo As String = "0|Zero Score|N|Unconfirmed" '<- Add more pairs here if you want
Application.ScreenUpdating = False
    
    Set Fnd = Rows(1).Find("Score", Range("A1"), , xlWhole, , , False, False)
    If Fnd.column = 4 Then
        Columns(Fnd.column).Cut
        Fnd.Offset(, -1).Insert
    End If
    
    With ActiveSheet
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Columns(4), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A:D")
            .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("C").Resize(, 2).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 actually works however if I try interchanging the "Score" next to "Name" and add some blank columns (until column Z). Some of the codes are not working.
Is there any code where we can sort it based on the Column name (basically Row A)? Thanks again for the help.

 

[Fluff]

Could you please supply a sample of what your data looks like?