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
384 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
 
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
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…
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

867 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

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now