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
388 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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

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.

Question has a verified solution.

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

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

733 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