Insert Blank Row, Offset and Copy\Paste

Results 1 to 6 of 6

Thread: Insert Blank Row, Offset and Copy\Paste

  1. #1
    Board Regular
    Join Date
    Sep 2011
    Location
    Leeds, England, United Kingdom
    Posts
    92
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Question Insert Blank Row, Offset and Copy\Paste

     
    OK, so bit of a tricky one for me anyway. I have a list of data that has zero blank rows separating different values:

    100
    100
    200
    200
    300
    300

    Now I've found this code to compare the cells above and below and where different to insert a blank row:

    Code:
    Sub InsertRowsAtValueChange()
    'Update 20140716
    Dim Rng As Range
    Dim WorkRng As Range
    On Error Resume Next
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    Application.ScreenUpdating = False
    For i = WorkRng.Rows.Count To 2 Step -1
        If WorkRng.Cells(i, 1).Value <> WorkRng.Cells(i - 1, 1).Value Then
            WorkRng.Cells(i, 1).EntireRow.Insert
        End If
    Next
    Application.ScreenUpdating = True
    End Sub
    So I now have this:

    100
    100
    200
    200
    300
    300

    What I need is some code to execute after or before but that goes to the cell above the blank row, copies the values of that cell, goes 12 columns over and pastes the data in. And this needs to happen for all the rows so it should come out looking like this:

    100
    100 100
    200
    200 200
    300
    300 300

    I'm not sure if that's clear enough but ask questions and I'll answer as clearly as I can.

    Thanks for any help.
    Last edited by TechTank; Dec 6th, 2017 at 07:27 PM.
    Work: Windows 7 32-bit Professional & Office 2010
    Home: Windows 7 64-bit Home Premium & Microsoft Office 2003

    "I'm an accidental genius...if only I could remember those moments of brilliance!"

  2. #2
    Board Regular
    Join Date
    Jan 2015
    Posts
    203
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert Blank Row, Offset and Copy\Paste

    Sub InsertRowsAtValueChange()
    'Update 20140716
    Dim Rng As Range
    Dim WorkRng As Range
    On Error Resume Next
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    Application.ScreenUpdating = False
    For i = WorkRng.Rows.Count To 2 Step -1
    If WorkRng.Cells(i, 1).Value <> WorkRng.Cells(i - 1, 1).Value Then
    WorkRng.Cells(i, 1).EntireRow.Insert

    WorkRng.Cells(i + 1, 12).Value = WorkRng.Cells(i + 1, 1)

    End If
    Next
    Application.ScreenUpdating = True
    End Sub

    I think all you need to do is add the line I inserted above.

    I hope this helps.

    ken

  3. #3
    Board Regular
    Join Date
    Jan 2015
    Posts
    203
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert Blank Row, Offset and Copy\Paste

    TT
    I oversimplified it a little. To suppress the number in column 12 for the first instance of a value, we need to check to make sure it has changed. So, the following should work a little better.

    Code:
    Sub InsertRowsAtValueChange()
    
    
    'Update 20140716
    
    
    Dim Rng As Range
    Dim WorkRng As Range
    Dim x As Variant
    
    
    On Error Resume Next
    
    
    xTitleId = "KutoolsforExcel"
    
    
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    
    
    Application.ScreenUpdating = False
    
    
    For i = WorkRng.Rows.Count To 2 Step -1
            
        If WorkRng.Cells(i - 1, 1).Value <> WorkRng.Cells(i, 1).Value Then
            WorkRng.Cells(i, 1).EntireRow.Insert
            If x <> WorkRng.Cells(i + 1, 1) Then WorkRng.Cells(i + 1, 12).Value = WorkRng.Cells(i + 1, 1)
        End If
           
        If x <> WorkRng.Cells(i - 1, 1) Then
            WorkRng.Cells(i - 1, 12).Value = WorkRng.Cells(i - 1, 1)
            x = WorkRng.Cells(i - 1, 1)
        End If
        
    Next
    
    
    Application.ScreenUpdating = True
    
    
    End Sub

  4. #4
    Board Regular
    Join Date
    Sep 2011
    Location
    Leeds, England, United Kingdom
    Posts
    92
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert Blank Row, Offset and Copy\Paste

    That works amazingly, thank you so much!

    I've worked out how to add two blank rows in (which I ideally need) and would like the copied values to be placed one row below where they were before. Is that possible at all?

    Also, the range to use will always be A:A so is it posible to strip out the code needed to use a selection box to specify the range or does that complicate matters? I'm guessing this is the code that is used for the selected box:
    Code:
    xTitleId = "KutoolsforExcel"
    
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    Sorry for asking more from you or anyone who follows.
    Last edited by TechTank; Dec 7th, 2017 at 10:00 AM.
    Work: Windows 7 32-bit Professional & Office 2010
    Home: Windows 7 64-bit Home Premium & Microsoft Office 2003

    "I'm an accidental genius...if only I could remember those moments of brilliance!"

  5. #5
    Board Regular
    Join Date
    Jan 2015
    Posts
    203
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert Blank Row, Offset and Copy\Paste

    TT
    It seems like it is already more complicated than it needs to be as far as your range identification. I would name the data area that you want to loop through something like "data"; it may be a dynamic range or a static range, but you probably don't need to be identifying it every time the code runs. I'm not sure exactly you want the values placed, but I am sure you can do it by adjusting the destination ranges (i+1 becomes i+2, maybe?). The Resize in the first IF loop makes it add two rows.
    Ken

    Sub test()


    Set R = Range("data")


    For i = R.Rows.Count To 2 Step -1

    If R(i - 1, 1).Value <> R(i, 1).Value Then
    R(i, 1).Resize(2, 1).EntireRow.Insert
    If x <> R(i + 1, 1) Then R(i + 1, 12).Value = R(i + 1, 1)
    End If

    If x <> R(i - 1, 1) Then
    R(i - 1, 12).Value = R(i - 1, 1)
    x = R(i - 1, 1)
    End If

    Next


    End Sub

  6. #6
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    5,011
    Post Thanks / Like
    Mentioned
    109 Post(s)
    Tagged
    4 Thread(s)

    Default Re: Insert Blank Row, Offset and Copy\Paste

      
    Here's another option
    Code:
    Sub InsertRowsAtValueChange()
        
        Dim i As Long
        
        Application.ScreenUpdating = False
        
        For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
            If Range("A" & i - 1).Value <> Range("A" & i).Value Then
                Rows(i).Resize(2).Insert
                Range("M" & i).Value = Range("A" & i - 1).Value
            End If
     Next
        Application.ScreenUpdating = True
    End Sub
    - Posting guidelines, forum rules and terms of use
    - Try searching for your answer first, see how
    - Read the FAQs
    - List of BB codes

    Running Office 2003 & 2013 on Win 7

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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

 

 
DMCA.com