Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
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
Medium Priority
?
403 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 34

Accepted Solution

by:
Norie earned 2000 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 34

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 34

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

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

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

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!
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
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…

721 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