Delete Rows in Sequence

**Jakila2** · 06-17-2011, 03:53 AM

I'm having difficulty with some data that is not on the same timeline. One series is monthly and the other is quarterly. My original thought was to convert the quarterly to monthly via estimation, but that might be overly complicated. It might be simpler to convert the monthly data to quarterly data by deleting the non-congruous months.

So I need a macro that will allow me to delete two out of every three months. For instance, if I only need January, April, July, and October data, I would need to delete the other months.

Here's what my data looks like:

Jan-1949 1.3%
Feb-1949 1.3%
Mar-1949 1.7%
Apr-1949 0.4%
May-1949 -0.4%
Jun-1949 -0.8%
Jul-1949 -2.9%
Aug-1949 -2.9%
Sep-1949 -2.4%
Oct-1949 -2.9%
Nov-1949 -1.7%
Dec-1949 -2.1%
Jan-1950 -2.1%
Feb-1950 -1.3%
Mar-1950 -0.8%
Apr-1950 -1.3%
May-1950 -0.4%
Jun-1950 -0.4%
Jul-1950 1.7%
Aug-1950 2.1%
Sep-1950 2.1%
Oct-1950 3.8%
Nov-1950 3.8%
Dec-1950 5.9%

Here's what I need it to look like after the deletions:

Jan-1949 1.3%
Apr-1949 0.4%
Jul-1949 -2.9%
Oct-1949 -2.9%
Jan-1950 -2.1%
Apr-1950 -1.3%
Jul-1950 1.7%
Oct-1950 3.8%

How would I design a macro to do this?

**MaczaQ** · 06-17-2011, 04:59 AM

Hi Jakila23

Let your data will be in sheet1 in column A

Try this code for delete rows you need. Copy it to Module and start delete_rows()

Sub delete_rows()
Dim allow
Dim forDelete As New Collection 'a list of rows for delete
allow = Array("JAN", "APR", "JUL", "OCT") 'this months will stay

For r = 1 To Sheets("Sheet1").UsedRange.Rows.Count
    If in_array(allow, Left(Sheets("sheet1").Cells(r, 1).Value, 3)) = -1 Then 'if month is not in array then will be take as row for delete
        forDelete.Add r
    End If
Next r

For i = forDelete.Count To 1 Step -1
    Sheets("Sheet1").Rows(forDelete(i) & ":" & forDelete(i)).delete shift:=xlUp 'delete rows from last to first
Next i

End Sub

Function in_array(ByRef allow, val As String) As Integer
in_array = -1
    For i = 0 To UBound(allow)
        If UCase(val) = allow(i) Then
            in_array = i
            Exit For
        End If
    Next i
End Function

Best Regards

**snb** · 06-17-2011, 05:40 AM

Assuming these data in 1 column:

Sub tst()
  sn = Application.Transpose(Columns(1).SpecialCells(2))

  For j = 1 To 12 Step 3
    sn = Filter(Filter(sn, LCase(Application.GetCustomListContents(3)(j + 1)), False), LCase(Application.GetCustomListContents(3)(j + 2)), False)
  Next

  Cells(1, 5).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub