1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Solved: Copy data to inserted rows

Discussion in 'Business Applications' started by rphilcart, Jul 15, 2011.

Thread Status:
Not open for further replies.
Advertisement
  1. rphilcart

    rphilcart Thread Starter

    Joined:
    Jul 15, 2011
    Messages:
    3
    Hi,
    I have a workbook (sample attached) which lists customer data in cols A to J. Each customer has a main ref (col B) and may have any number of secondary refs in cols L onwards. Col K shows how many secondary refs the customer has, and is used in the code below to determine how many blank rows to add for those customers that have 1 or more secondary refs (1 row per ref)
    Sub Insert_Row()
    Dim LASTROW As Long
    Dim I As Long
    LASTROW = Range("C" & Rows.Count).End(xlUp).Row
    For I = LASTROW To 2 Step -1
    If ((IsNumeric(Cells(I, "K"))) And (Cells(I, "K") <> Empty)) Then
    Range(Cells(I + 1, 1), Cells(I + Cells(I, "K"), 1)).EntireRow.Insert
    End If
    Next I
    End Sub
    The attached shows the worksheet having run the code
    What I need now is for the code to do 2 more things –
    1. Once the blank rows have been inserted for e.g. the customer in row 5, the value in L5 to be copied to B6, and the value in M5 to be copied to B7. (Could select, then transpose?)
    2. Then copy the values in cells C5:J5 into the same columns in rows 6 & 7. (Not bothering with col A)
    Sheet 2 shows the end result I’m after Basically, I’m consolidating main and secondary refs for each customer into one list.
    Hope someone can help?
    Cheers,
    Phil
     

    Attached Files:

  2. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,553
    First Name:
    Hans
    Hi Phil,
    Welcome to the forum.
    I think it can be done with an additional macro.
    It's late here but I'll see if I can put it together sometime tomorrow (Sunday).
     
  3. rphilcart

    rphilcart Thread Starter

    Joined:
    Jul 15, 2011
    Messages:
    3
    Hi Hans,
    Many thanks for taking time to help me. I have been trying to help myself, and have added some macros -

    Once the necessary blank rows have been inserted, I populate col A with the country ref with the FillCountryCode macro

    Then I use CopySecRefs to copy however many sec refs there are in col L onwards

    Then I use PasteTranspose to paste the sec refs into the blank rows.
    The loop runs ok until it gets to row 10, when it then wipes out any subsequent Main refs without copying the sec refs.

    This is as far as I've got if it's any help, but you may be quicker following your own logic than picking through mine!
    Sheet 3 on the attached illustrates the above.

    Once again, very many thanks for your time and trouble.

    Phil
     

    Attached Files:

  4. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,553
    First Name:
    Hans
    Good morning Phil,
    I'll take a look and add 'my stuff' to your code.
    I have it in my head but still need to put it in code.
    I'll see how far I get today.
     
  5. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,553
    First Name:
    Hans
    I haven't done much but this will at least corect this part, you 'forgot ' to determine the last column

    Code:
    Sub CopySecRefs()
    '
    ' CopySecRefs Macro
        Dim LASTROW As Long
        Dim z As Long
        
    [COLOR="Red"]    Dim x As Long[/COLOR]
        
        
        LASTROW = Range("A" & Rows.Count).End(xlUp).Row
        For z = LASTROW To 2 Step -1
            If (Cells(z, "L") <> Empty) Then
            Range("L" & z).Select
    [COLOR="Red"]' You need to determine the last filled column
            x = Cells(z, Columns.Count).End(xlToLeft).Column
            Range(Selection, Cells(z, x)).Select[/COLOR]
            Selection.Copy
            Range("B" & z + 1).Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        End If
        
        Next z
    End Sub
    
    
    I added and two lines of code and changed one.
    More to follow
     
  6. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,553
    First Name:
    Hans
    It was easier thatn I thought

    Replace all the macro code with the code below and run it to do all the tasks
    Keep in mind that you should inlcude a line of code to set column K to 0 to avoid rearranging the values if you press the button or exceute the macro agaian by accident

    Code:
    Option Explicit
    
    Sub CarryOutTheJob()
        Insert_Row
        CopySecRefs
        Range("A1").Select
    End Sub
    
    Sub Insert_Row()
        Dim LASTROW As Long
        Dim i As Long
        LASTROW = Range("C" & Rows.Count).End(xlUp).Row
        For i = LASTROW To 2 Step -1
            If ((IsNumeric(Cells(i, "K"))) And (Cells(i, "K") <> Empty)) Then
                Range(Cells(i + 1, 1), Cells(i + Cells(i, "K"), 1)).EntireRow.Insert
            End If
        Next i
    End Sub
    
    Sub CopySecRefs()
    '
    ' CopySecRefs Macro
        Dim LASTROW As Long
        Dim z As Long
        Dim x As Long
        Dim k As Integer
        LASTROW = Range("A" & Rows.Count).End(xlUp).Row
        For z = LASTROW To 2 Step -1
            If (Cells(z, "L") <> Empty) Then
                Range("L" & z).Select
    ' You need to determine the last filled column
                x = Cells(z, Columns.Count).End(xlToLeft).Column
                k = Cells(z, "K")
                Range(Selection, Cells(z, x)).Select
                Selection.Copy
                Range("B" & z + 1).Select
                Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                
        ' Fill Country Code
                Range(Cells(z + 1, "A"), Cells(z + k, "A")) = Range("A" & z)
                
        ' Fill C-J
                Range("C" & z & ":J" & z).Select
                Selection.Copy
                Range("C" & z + 1 & ":J" & z + k).Select
                Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End If
        Next z
    End Sub
    
    
     
  7. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,553
    First Name:
    Hans
    Hi Phil,
    I did some additional editting and have attached file version 2.2
    There is a short explanation in the VBA project itself.
    The Module is named PhilsModule and contains only the code used to avoid cinfusion.

    I als added the functionality that will remove the sec values and set the K value to 0 after the macro is run so in case you run the macro again no rows will be inserted or changed.
    This will make it possible to add sec specs and in K is > 0 the macro will run and "do it's thing"
     

    Attached Files:

  8. rphilcart

    rphilcart Thread Starter

    Joined:
    Jul 15, 2011
    Messages:
    3
    Hi Hans,

    You are a Star - your code works fine. I am working in Scotland for a few days, but I'll try it on the full dataset (128,000 rows) when I get home.

    I'll study your code to try and learn where I was going wrong!

    Very many thanks. Your help is very much appreciated. If you are ever in England, and come to Worcester, I'll buy you some beers!

    Best Wishes,

    Phil
     
  9. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,553
    First Name:
    Hans
    Thanks for the compliment.
    I just used your code and changed it accordingly, you did the first steps.
    Any questions, just ask.
    Thanks for the offer, you never know.
     
  10. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,553
    First Name:
    Hans
    Hi Phil,
    After I let it sink in and you mentioned that you were about to process 128000 rows of data, I had to edit the code.
    And the resaon is quite simple, let's say you keep on inserting rows, there is no test except an error message and the macro to be stopped qhen you exceed the 1048565 rows allowed in Excel.
    I know this will probably not hapen but just in case I added a check function and an extra check in the if then else when inserting rows.

    The "new" version is 2.3 and the info is in the VBA project.

    You could also add a line of code Application.Screeupdating = False befor the first line of code is called

    and Application.Screeupdating = True before the Range("A1").select line of code.

    This makes the processing faster because the screen does not have to be updated while processing.
     

    Attached Files:

  11. Sponsor

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1007520

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice