+ Reply to Thread
Results 1 to 2 of 2

Insert new rows between existing cells with missing sequential dates

Hybrid View

madball87 Insert new rows between... 07-06-2011, 11:18 AM
jaslake Re: Insert new rows between... 07-09-2011, 11:06 AM
  1. #1
    Registered User
    Join Date
    07-06-2011
    Location
    Scotland
    MS-Off Ver
    Excel 2003
    Posts
    7

    Insert new rows between existing cells with missing sequential dates

    I've got several spreadsheets where I have a list of dates and balances in Columns A & B, however column A doesn't contain all the dates. I need a macro where I can insert additional rows between cell where there is a value in Column A. In addition to this I also need these inserted rows to be populated with date in Column A (Target Data V1 - so that column A runs sequentially from start to finish with no omissions or gaps), and the balance value in Column B to the populate any blanks with the value from the previous row (Target Data V2).

    I can figure out how to insert rows, but not the correct number based on the differences in the value between 2 cells.

    Anyone offer any suggestions?
    Attached Files Attached Files

  2. #2
    Forum Expert jaslake's Avatar
    Join Date
    02-21-2009
    Location
    Atwood Lake in Mid NE Ohio...look it up.
    MS-Off Ver
    Excel 2010 2019
    Posts
    12,749

    Re: Insert new rows between existing cells with missing sequential dates

    Hi madball87

    See if this code does as you require
    Option Explicit
    Sub insert_rows()
        Dim rng As Range
        Dim LR As Long
        Dim i As Long
        Dim x As Long
        Application.ScreenUpdating = False
        LR = Range("A" & Rows.Count).End(xlUp).Row
        Set rng = Range("A4:A" & LR)
        With rng
            For i = LR To 2 Step -1
                x = DateDiff("d", rng(i).Offset(-1, 0).Value, rng(i).Value)
                If x > 1 Then
                    rng(i).Resize(x - 1, 1).EntireRow.Insert
                    Range(rng(i).Offset(-1, 0).Address).AutoFill Destination:=Range(rng(i).Offset(-1, 0).Address & ":" & rng(i).Offset(x - 1, 0).Address), Type:=xlFillDefault
                    Range(rng(i).Offset(-1, 1).Address).Copy Destination:=Range(rng(i).Offset(0, 1).Address & ":" & rng(i).Offset(x - 2, 1).Address)
                End If
            Next i
        End With
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End Sub
    John

    If you have issues with Code I've provided, I appreciate your feedback.

    In the event Code provided resolves your issue, please mark your Thread as SOLVED.

    If you're satisfied by any members response to your issue please use the star icon at the lower left of their post.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1