Home > Back-end >  VBA Excel Find all rows that don't fit the requirements of the sequence and clear
VBA Excel Find all rows that don't fit the requirements of the sequence and clear

Time:03-10

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

CodePudding user response:

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

CodePudding user response:

I am assuming that this code could get what you are looking for done with some added portions with what you are looking to do with it.

Sub Test()

Dim RepRow, LastRow As Long

LastRow = Sheet1.Range("E9999").End(xlUp).Row

With Sheet1

For RepRow = 2 To LastRow

If Range("E" & RepRow).Value < 5 Then
Range("E" & RepRow).Interior.ColorIndex = 17  'Change this row to do what you need done
End If

Next RepRow

End With

End Sub

Assuming that this is on Sheet1 and the value you are looking for is in column E like the image you have attached.

  • Related