Excel 2007 VBA copy rows x times based on text filter

Question

I\'m new to VBA and can;t wrap my head around the most efficient way to do this - what I\'m looking for is a way to copy my data into rows below the active cell based upon a fre

Answer 1

Davin

Wilhelm, asked a valid question. I am still going ahead and assuming that by saying 'Quarterly' you just want to add 4 months.

I am also assuming that (I guess I am correct on this one though) you want to keep on incrementing the dates till the time they are less than 1st March 2013 (immaterial of the fact whether it is ANNUAL, QUARTERLY or MONTHLY)

Please try this code. I am sure it can be made more perfect. ;)

TRIED AND TESTED

Option Explicit

Sub Sample()
    Dim ws As Worksheet, ws1 As Worksheet
    Dim i As Long, j As Long, LastRow As Long
    Dim boolOnce As Boolean
    Dim dt As Date

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    '~~> Input Sheet
    Set ws = Sheets("Sheet1")
    '~~> Output Sheet
    Set ws1 = Sheets("Sheet2")
    ws1.Cells.ClearContents

    '~~> Get the last Row from input sheet
    LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

    boolOnce = True

    '~~> Loop through cells in Col A in input sheet
    For i = 2 To LastRow
        j = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row + 1

        Select Case UCase(ws.Range("C" & i).Value)
            Case "ANNUAL"
                dt = DateAdd("yyyy", 1, ws.Range("D" & i).Value)
                '~~> Check if the date is less than 1st march 2013
                If dt <= #3/1/2013# Then
                    ws1.Range("A" & j & ":A" & j + 1).Value = ws.Range("A" & i).Value
                    ws1.Range("B" & j & ":B" & j + 1).Value = ws.Range("B" & i).Value
                    ws1.Range("C" & j & ":C" & j + 1).Value = ws.Range("C" & i).Value
                    ws1.Range("D" & j).Value = ws.Range("D" & j).Value
                    ws1.Range("D" & j + 1).Value = DateAdd("yyyy", 1, ws.Range("D" & i).Value)
                End If
            Case "QUARTERLY"
                dt = DateAdd("M", 4, ws.Range("D" & i).Value)
                Do While dt <= #3/1/2013#
                    ws1.Range("A" & j).Value = ws.Range("A" & i).Value
                    ws1.Range("B" & j).Value = ws.Range("B" & i).Value
                    ws1.Range("C" & j).Value = ws.Range("C" & i).Value
                    If boolOnce = True Then
                        ws1.Range("D" & j).Value = DateAdd("M", -4, dt)
                        boolOnce = False
                    Else
                        ws1.Range("D" & j).Value = dt
                    End If
                    dt = DateAdd("M", 4, ws1.Range("D" & j).Value)
                    j = j + 1
                Loop
                boolOnce = True
            Case "MONTHLY"
                dt = DateAdd("M", 1, ws.Range("D" & i).Value)
                Do While dt <= #3/1/2013#
                    ws1.Range("A" & j).Value = ws.Range("A" & i).Value
                    ws1.Range("B" & j).Value = ws.Range("B" & i).Value
                    ws1.Range("C" & j).Value = ws.Range("C" & i).Value
                    If boolOnce = True Then
                        ws1.Range("D" & j).Value = DateAdd("M", -1, dt)
                        boolOnce = False
                    Else
                        ws1.Range("D" & j).Value = dt
                    End If
                    dt = DateAdd("M", 1, ws1.Range("D" & j).Value)
                    j = j + 1
                Loop
                boolOnce = True
        End Select
    Next i

LetsContinue:
    Application.ScreenUpdating = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Snapshot

Answer 2

You need a function that translate the frequency text to a number of months (let´s call it MonthFreq returning an integer).

This will do what you want:

MaxDate = DateSerial(2013, 4, 1)
Do Until Origin.Cells(OriginRow, NameColumn).Value = ""
    SourceDate = Origin.Cells(OriginRow, DateColumn).Value
    Do Until SourceDate >= MaxDate
        ' Copy origin row to destiny.
        Destiny.Cells(DestinyRow, DateColumn).Value = SourceDate

        SourceDate = DateAdd("m", MonthFreq(Origin.Cells(OriginRow, FreqColumn).Value), SourceDate)
        DestinyRow = DestinyRow + 1
    Loop
    OriginRow = OriginRow + 1
Loop

Origin is the worksheet with the original data, Destiny is the worksheet where the expanded data will be saved. OriginRow is the current row being analyzed in the Origin worksheet (starts at the first row). OriginColumn is the current row being written in the Destiny worksheet (starts at the first row). SourceDate will be added some number of months until it reaches the MaxDate.