VB Code to clean up Payroll Data by deleting rows

Hi rmomin,

Here's one way:

Option Explicit
Sub Macro1()
    
    Dim wsSrc As Worksheet, wsDestin As Worksheet
    Dim i As Long, j As Long
    
    Application.ScreenUpdating = False
    
    Set wsSrc = Sheets("Sheet1")
    Set wsDestin = Sheets("Sheet2")
    
    For i = 2 To wsSrc.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        If StrConv(wsSrc.Range("A" & i), vbProperCase) = "Salary" Then
            j = IIf(j = 0, 2, j + 1)
            wsDestin.Range("A" & j).Value = wsSrc.Range("A" & i - 1)
            wsDestin.Range("B" & j).Value = wsSrc.Range("B" & i - 1)
            wsDestin.Range("C" & j).Value2 = wsSrc.Range("C" & i).Value2
            wsDestin.Range("D" & j).Value = wsSrc.Range("D" & i - 1)
        End If
    Next i
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

Another Option...

Sub J3v16()
With Range("A2:D" & Cells(Rows.Count, 4).End(xlUp).Row)
    With .Columns(3).SpecialCells(xlCellTypeBlanks): .FormulaR1C1 = "=R[1]C": .Value = .Value: End With
    With .Columns(4): .Replace "Amount", "": .SpecialCells(xlCellTypeConstants, xlNumbers).Clear: .SpecialCells(xlCellTypeBlanks).EntireRow.Delete: End With
End With
End Sub

Glad I could contribute...

Looks like I will need help in changing previosly done macro as it is malfunctioning.

It's not that the codes are malfunctioning but your requirement (data layout) has changed

See how this goes:

Option Explicit
Sub Macro2()
    
    Dim wsSrc As Worksheet, wsDestin As Worksheet
    Dim i As Long, j As Long
    
    Application.ScreenUpdating = False
    
    Set wsSrc = Sheets("Sheet1")
    Set wsDestin = Sheets("Sheet2")
    
    For i = 2 To wsSrc.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        If InStr(wsSrc.Range("D" & i), ",") > 0 Then
            j = IIf(j = 0, 2, j + 1)
            wsDestin.Range("A" & j).Value = wsSrc.Range("A" & i)
            wsDestin.Range("D" & j).Value = wsSrc.Range("D" & i)
            wsDestin.Range("G" & j).Value2 = wsSrc.Range("G" & i + 1).Value2
            wsDestin.Range("M" & j).Value = wsSrc.Range("M" & i)
            wsDestin.Range("P" & j).Value = wsSrc.Range("P" & i)
        End If
    Next i
    
    Application.ScreenUpdating = True

End Sub

As Trebor says...Complete different data setup...

Sub J3v16()
With Range("A1:P" & Cells(Rows.Count, 1).End(xlUp).Row)
    Union(.Columns(7), .Columns(16)).NumberFormat = "General"
    With .Columns(7).SpecialCells(xlCellTypeBlanks): .FormulaR1C1 = "=R[1]C": End With
    With .Columns(7).CurrentRegion: .Value = .Value: End With
    With .Columns(3): .SpecialCells(xlCellTypeConstants).EntireRow.Delete: End With
    With .Columns(4): .SpecialCells(xlCellTypeBlanks).EntireRow.Delete: End With
End With
End Sub