Solved

1. Insert Empty Rows in worksheet A. Copy Range from worksheet B. Paste Range to Each Empty Rows until end of worksheet A

Posted on 2011-09-14
9
387 Views
Last Modified: 2012-05-12
Hi, I am looking to paste a range by VBA to a massive document sparing me valuable time.

1. Insert Empty Row(s) before each Name change in Column D of worksheet A.
2. Copy Named Range ("A2:V13") from worksheet B.
3. Paste Named Range to Each Empty Row(s) starting at Column A until end of worksheet A.

Worksheet A is usually 65000 lines long by 22 columns large with a minimum of 250+ Name changes.

-----------------------------------------------
I have used the following subs:

Insert Empty Lines (works fine - might no be best):

Option Compare Text
Sub addRows()
    Dim Rw     As Long
    Dim LastRw As Long
    LastRw = ActiveSheet.UsedRange.Rows.Count
   ' loop through column D
    For Rw = LastRw To 2 Step -1
    'ignore empty cells
        If Not IsEmpty(Cells(Rw - 1, 1)) Then
        'if the cells don't match add a row
            If Cells(Rw, 1).Value <> Cells(Rw - 1, 1).Value Then
                Cells(Rw, 1).EntireRow.Insert Shift:=xlDown
                Cells(Rw, 1).EntireRow.Insert Shift:=xlDown
                Cells(Rw, 1).EntireRow.Insert Shift:=xlDown
                Cells(Rw, 1).EntireRow.Insert Shift:=xlDown
                Cells(Rw, 1).EntireRow.Insert Shift:=xlDown
                Cells(Rw, 1).EntireRow.Insert Shift:=xlDown
                Cells(Rw, 1).EntireRow.Insert Shift:=xlDown
                Cells(Rw, 1).EntireRow.Insert Shift:=xlDown
                Cells(Rw, 1).EntireRow.Insert Shift:=xlDown
                Cells(Rw, 1).EntireRow.Insert Shift:=xlDown
                Cells(Rw, 1).EntireRow.Insert Shift:=xlDown
                Cells(Rw, 1).EntireRow.Insert Shift:=xlDown
            End If
        End If
    Next Rw
End Sub

------------------------------------------
Copy Range Paste to worksheet A (copy+paste OK but not to each empty rows):
Sub PasteRange()
Sheets("YellowCells").Range("A3:V14").Copy
Do
Sheets("MacroTest").Range("A" & Sheets("MacroTest").Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteFormats)
Sheets("MacroTest").Range("A" & Sheets("MacroTest").Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteFormulas)
Loop
End Sub
--------------------------------------------

Thanks in advance for the time you take to review this.

 
0
Comment
Question by:fredericgilbert
  • 5
  • 3
9 Comments
 
LVL 24

Expert Comment

by:StephenJR
ID: 36538399
Do you mean that, e.g., if row 5 is different from row 6 then you want to insert your range A2:V13 between them? Also, your code is comparing column A but you refer to column D in your question.
0
 
LVL 24

Expert Comment

by:StephenJR
ID: 36538407
If you could post a small workbook that would probably clear it all up.
0
 

Author Comment

by:fredericgilbert
ID: 36538703
Hi StephenJR,

Yes, if row 5 is different from row 6 then you want to insert your range A2:V13 between them.
The Name change occurs in Column D while the empty (inserted) rows the sub is checking are in column A.

Here is a workbook (much smaller than the regular).
 20110914-ExpertsExchange-workdoc.xlsm
0
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 33

Accepted Solution

by:
Norie earned 500 total points
ID: 36538790
Try this.
Option Explicit

Sub InsertNamedRange()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim rngdst As Range
Dim rngSrc As Range

Set wsA = Worksheets("A")
Set wsB = Worksheets("B")
    Set rngdst = wsA.Range("d2")
    Set rngSrc = wsB.Range("NamedRange")
    
    While rngdst.Value <> ""
           If rngdst.Value <> rngdst.Offset(1) Then
                rngdst.Offset(1).Resize(rngSrc.Rows.Count).EntireRow.Insert
                
                rngSrc.Copy rngdst.Offset(1, -3)
                Set rngdst = rngdst.Offset(rngSrc.Rows.Count)
            End If
            
        Set rngdst = rngdst.Offset(1)
    Wend
End Sub

Open in new window

0
 
LVL 24

Expert Comment

by:StephenJR
ID: 36538898
Does this work?
Sub addRows()
    Dim Rw     As Long
    Dim LastRw As Long
    
    LastRw = Range("D" & Rows.Count).End(xlUp).Row
   ' loop through column D
    For Rw = LastRw + 1 To 3 Step -1
    'ignore empty cells
        If Not IsEmpty(Cells(Rw - 1, 4)) Then
        'if the cells don't match add a row
            If Cells(Rw, 4).Value <> Cells(Rw - 1, 4).Value Then
                Cells(Rw, 1).EntireRow.Resize(12).Insert Shift:=xlDown
                Sheets("YellowCells").Range("A2:V13").Copy
                Cells(Rw, 1).PasteSpecial xlPasteFormulas
                Cells(Rw, 1).PasteSpecial xlPasteFormats
            End If
        End If
    Next Rw
End Sub

Open in new window

0
 
LVL 33

Expert Comment

by:Norie
ID: 36538932
Stephen

Why are you looping backwards?

It isn't really necessary unless you are deleting.

You just need to keep a close eye on your offsets, no of rows etc.
0
 
LVL 24

Expert Comment

by:StephenJR
ID: 36539106
imnorie: suppose I was being lazy and tweaking the OP's code!

fredericgilbert: don't mention it.
0
 
LVL 33

Expert Comment

by:Norie
ID: 36539738
Stephen

Sorry to have asked, but I've always wondered.

I suppose looping backwards is easier
0
 
LVL 24

Expert Comment

by:StephenJR
ID: 36541769
imnorie - nothing to apologise for. If I were starting from scratch I would not necessarily have done it that way. And your method is no doubt more efficient.
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…

861 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question