VBA Excel Find all rows that don't fit the requirements of the sequence and clear

user_18335615 0
Viewed 74

I am very much a beginner in coding and I am trying to write a macro for a large data set at the request of my company. So the data set is much larger than the below screenshot but I am trying to write a macro that will look at the Rep column and add a blank row for Panelists who's rep ends before 5. So for each panelist/screening combo I need it to be able to identify the sequences (0-5) that end before 5. I have searched the internet for weeks to figure out how/where to start writing this. I am hoping to get some guidance on ways I can approach writing this. Sample Data Set

vba excel
2 Answers

This below code will add a row after every set that does not have 5 reps.

Sub Test()

Dim RepRow, LastRow As Long

Application.ScreenUpdating = False

With Sheet1

RepRow = 2  ' Set this to whatever row your data starts on

Do While Not IsEmpty(Range("A" & RepRow))

    If Range("E" & RepRow).Value - Range("E" & RepRow + 1).Value > 0 And Range("E" & RepRow).Value < 5 Then

    Range("A" & RepRow + 1).EntireRow.Insert

    RepRow = RepRow + 2

    End If

    RepRow = RepRow + 1

Loop

End With

Application.ScreenUpdating = True

End Sub

You will still have to update the E in the above code to whatever column the reps are in and possibly the A to another column with data.

user_130396500

Insert Blank Rows

  • It is assumed that the data 'nicely' starts in cell A1 and has one row of headers and has no empty rows or columns.
Option Explicit

Sub InsertBefore0()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    Dim crg As Range: Set crg = rg.Columns(5)
    
    Dim drg As Range
    Dim cCell As Range
    Dim r As Long
    Dim m As Long
    
    For r = 3 To rg.Rows.Count
        Set cCell = crg.Cells(r)
        If cCell.Value = 0 Then
            If cCell.Offset(-1).Value < 5 Then
                If drg Is Nothing Then ' combine cells into a range
                    Set drg = cCell.Offset(, m)
                Else
                    Set drg = Union(drg, cCell.Offset(, m))
                End If
                m = (m + 1) Mod 2 ' prevent two consecutive rows inserted
            End If
        End If
    Next r
        
    If drg Is Nothing Then Exit Sub
    
    drg.EntireRow.Insert xlShiftDown, xlFormatFromLeftOrAbove
        
    MsgBox "Blank rows inserted.", vbInformation
    
End Sub
user_98140690
Related