none
Excel macro - Want to add rows and copy data based on column value

    Question

  • Hi All,

    I am new to writing macros to excel. I believe this is something achievable writing macros.

    I have data like

    From Date      To Date            Days      Cost

    1-Jan-13      31-Jan-13          31         100

    1-Mar-13      31-Mar-13         31         400

    1-Apr-13       12-Apr-13         12         500

    Based on number of days, I want that many number of records for that row with dates as 1-Jan-13, 2-Jan-13.. 31-Jan-13 etc.

    So data should be like-

    Date      Cost

    1-Jan-13  100

    2-Jan-13   100

    .

    .

    31-Jan-13  100

    Can somebody help me with this? Thanks in advance.

    Sunny

    Monday, July 22, 2013 10:15 AM

Answers

  • Try this macro:

    Sub SplitDates()
        Const lngFirstSourceRow = 2 ' first data row
        Const lngFirstSourceCol = 1 ' first data column (A)
        Dim wshSource As Worksheet
        Dim wshTarget As Worksheet
        Dim lngSourceRow As Long
        Dim lngLastSourceRow As Long
        Dim lngTargetRow As Long
        Dim dtmDate As Date
        ' Do not update the screen for speed
        Application.ScreenUpdating = False
        ' Source sheet is the active sheet
        Set wshSource = ActiveSheet
        ' Get the last row
        lngLastSourceRow = wshSource.Cells(wshSource.Rows.Count, lngFirstSourceCol).End(xlUp).Row
        ' Create target sheet
        Set wshTarget = Worksheets.Add(After:=wshSource)
        ' Header text
        wshTarget.Cells(1, 1) = "Date"
        wshTarget.Cells(1, 2) = "Cost"
        ' Format first column
        wshTarget.Columns(1).NumberFormat = "d-mmm-yy"
        ' Initialize row
        lngTargetRow = 2
        ' Loop through the source rows
        For lngSourceRow = lngFirstSourceRow To lngLastSourceRow
            ' Loop through the dates
            For dtmDate = wshSource.Cells(lngSourceRow, lngFirstSourceCol).Value To _
                    wshSource.Cells(lngSourceRow, lngFirstSourceCol + 1).Value
                ' Date to column A
                wshTarget.Cells(lngTargetRow, 1).Value = dtmDate
                ' Cost to column B
                wshTarget.Cells(lngTargetRow, 2).Value = _
                    wshSource.Cells(lngSourceRow, lngFirstSourceCol + 3).Value
                ' Increment row
                lngTargetRow = lngTargetRow + 1
            Next dtmDate
        Next lngSourceRow
        ' Autofit columns
        wshTarget.Range("A1:B1").EntireColumn.AutoFit
        ' Update screen
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar

    • Marked as answer by Sunny Dagliya Tuesday, July 23, 2013 10:53 AM
    Monday, July 22, 2013 1:43 PM

All replies

  • Try this macro:

    Sub SplitDates()
        Const lngFirstSourceRow = 2 ' first data row
        Const lngFirstSourceCol = 1 ' first data column (A)
        Dim wshSource As Worksheet
        Dim wshTarget As Worksheet
        Dim lngSourceRow As Long
        Dim lngLastSourceRow As Long
        Dim lngTargetRow As Long
        Dim dtmDate As Date
        ' Do not update the screen for speed
        Application.ScreenUpdating = False
        ' Source sheet is the active sheet
        Set wshSource = ActiveSheet
        ' Get the last row
        lngLastSourceRow = wshSource.Cells(wshSource.Rows.Count, lngFirstSourceCol).End(xlUp).Row
        ' Create target sheet
        Set wshTarget = Worksheets.Add(After:=wshSource)
        ' Header text
        wshTarget.Cells(1, 1) = "Date"
        wshTarget.Cells(1, 2) = "Cost"
        ' Format first column
        wshTarget.Columns(1).NumberFormat = "d-mmm-yy"
        ' Initialize row
        lngTargetRow = 2
        ' Loop through the source rows
        For lngSourceRow = lngFirstSourceRow To lngLastSourceRow
            ' Loop through the dates
            For dtmDate = wshSource.Cells(lngSourceRow, lngFirstSourceCol).Value To _
                    wshSource.Cells(lngSourceRow, lngFirstSourceCol + 1).Value
                ' Date to column A
                wshTarget.Cells(lngTargetRow, 1).Value = dtmDate
                ' Cost to column B
                wshTarget.Cells(lngTargetRow, 2).Value = _
                    wshSource.Cells(lngSourceRow, lngFirstSourceCol + 3).Value
                ' Increment row
                lngTargetRow = lngTargetRow + 1
            Next dtmDate
        Next lngSourceRow
        ' Autofit columns
        wshTarget.Range("A1:B1").EntireColumn.AutoFit
        ' Update screen
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar

    • Marked as answer by Sunny Dagliya Tuesday, July 23, 2013 10:53 AM
    Monday, July 22, 2013 1:43 PM
  • Thank you so much Hans, it helped me.

    Also it will be a good start to work on macros.

    Appreciate your support.

    -Sunny

    Tuesday, July 23, 2013 10:54 AM