Copy and Insert/Overwrite

lkirke
lkirke used Ask the Experts™
on
Hi Experts,

Have the following piece of code that I need to adjust.

Basically, the code copy's the named range 'SiteFlows', finds a match to what is in cell A11, then inserts 'SiteFlows' below the match within the range of A61:A65536.

However, if I execute the code twice, it obviously copies the 'SiteFlows' range again below the match and below the already copied data. How can I adjust the code to be a little smarter so that if I have already copied and inserted before, it just copies and overwrites the existing data underneath the match.

I have attached a example for assistance and hoped I haven't confused you too much. :-)
http://s6.quicksharing.com/v/1102894/.html 


Public Sub CopyAndInsert_SiteFlows()

   Dim Row As Long
   
   With ActiveSheet
      Row = Application.Match(.[A11], .[A61:A65536], 0)
      If Row > 0 Then
         .Rows(Row + 61).Resize([SiteFlows].Rows.Count).Insert
         [SiteFlows].EntireRow.Copy .Rows(Row + 61).Resize([SiteFlows].Rows.Count)
        .Rows(Row + 61).Resize([SiteFlows].Rows.Count).Value = .Rows(Row + 61).Resize([SiteFlows].Rows.Count).Value
      End If
   End With

End Sub

Regards

LK
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2008

Commented:
The problem with your request is there is no way to determine if the key found was previously copied. Unless there is something you are not telling us?

There is no file to download at the URL you provided.

Kevin

Author

Commented:
Hi Kevin,

Just wait 20secs for the download to kick in then click on Download File.

Regards

LK
Top Expert 2008

Commented:
I did...it says there is nothing there.

Kevin
Learn Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

Top Expert 2008

Commented:
Files can be posted any of a number of ways.

The prefered method at this time is to use the Experts-Exchange file sharing site. It is available to all registered Experts-Exhange members and it is free. First zip the file or files to be posted. Then navigate to http://www.ee-stuff.com, click Login in the upper right corner, enter your Experts-Exhange user name and password, click the Login command button, navigate to Expert Area, and click "Upload a new file". Enter the complete URL of the question, or the Question ID into the text box labeled "Question", and then click "Browse..." to select the desired file to upload. The question ID is the eight-digit number after the "Q_" in the question URL. Type a comment describing the file. Click "Upload" to upload the file. A page will then be presented with a URL that can be posted in the Experts-Exchange question so that others can download the file.

There are other free file sharing services available:

Geocities: http://geocities.yahoo.com/ps/learn2/HowItWorks4_Free.html
AngelFire: http://www.angelfire.lycos.com/doc/subscriptions/index.html
Google: http://base.google.com/base/default 
RapidUpload: http://www.rapidupload.com/

If you do not want to use any of these services you can send your file to me using the email address in my profile (http://www.experts-exchange.com/M_1677072.html) and I will post it on my own site.

Kevin

Author

Commented:
Thanks for that.

Try this link.

http://www25.rapidupload.com/d.php?file=dl&filepath=10961 

Regards

LK

Author

Commented:
Kevin,

As you might see from the file, there is a 2 line gap between each SITE. Could we basically say that if the gap is greater than 2 lines, delete, copy then insert ?

Regards

LK
Top Expert 2008

Commented:
Try this version:

Public Sub CopyAndInsert_SiteFlows()

   Dim Row As Long
   
   With ActiveSheet
      Row = Application.Match(.[A11], .[A61:A65536], 0)
      If Row > 0 Then
         If Len(.Cells(Row + 61)) > 0 Then
            .Cells(Row + 61).Resize([SiteFlows].Rows.Count).EntireRow.Delete
         End If
         .Rows(Row + 61).Resize([SiteFlows].Rows.Count).Insert
         [SiteFlows].EntireRow.Copy .Rows(Row + 61).Resize([SiteFlows].Rows.Count)
        .Rows(Row + 61).Resize([SiteFlows].Rows.Count).Value = .Rows(Row + 61).Resize([SiteFlows].Rows.Count).Value
      End If
   End With

End Sub

Kevin

Author

Commented:
Still having the same issue Kevin.
Top Expert 2008
Commented:
Yup...I tested this version :-)

Public Sub CopyAndInsert_SiteFlows()

   Dim Row As Long
   
   With ActiveSheet
      Row = Application.Match(.[A11], .[A61:A65536], 0)
      If Row > 0 Then
         If Len(.Cells(Row + 61, 1)) > 0 Then
            .Cells(Row + 61, 1).Resize([SiteFlows].Rows.Count).EntireRow.Delete
         End If
         .Rows(Row + 61).Resize([SiteFlows].Rows.Count).Insert
         [SiteFlows].EntireRow.Copy .Rows(Row + 61).Resize([SiteFlows].Rows.Count)
        .Rows(Row + 61).Resize([SiteFlows].Rows.Count).Value = .Rows(Row + 61).Resize([SiteFlows].Rows.Count).Value
      End If
   End With

End Sub

Kevin

Author

Commented:
You are a god. :-)

Thankyou Kevin.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial