none
VBA copy until blank and copy again until next blank then paste RRS feed

  • Question

  • Can anyone help me out with the following VBA script? I am trying to copy the first row until blank column and then go down to the next filled row, etc. then paste in a table. The following is the data: Ideally it would Copy B1:F1 then stop Paste in B30:F30, then skip blank rows and copy row B10:f10 and B11:f10 then Paste in B31:F30, then copy B20:F30, B21:F21, B22:F22 and then Paste B32:F32? It could also copy then paste after all copies if easier. The data will always change in the number of items in each set of 9 rows depending on the input so a macro record will not work properly. Also, ideally it would sort alphabetically and remove duplicates but I can record second macro to sort and remove duplicates. Any help is appreciated. Thanks!

    A B C D E F
    1 Apples Apples Apples Apples Apples
    2
    3
    4
    5
    6
    7
    8
    9
    10 Oranges Oranges Oranges Oranges Oranges
    11 Apples Apples Apples Apples Apples
    12
    13
    14
    15
    16
    17
    18
    19
    20 Plumbs Plumbs Plumbs Plumbs Plumbs
    21 Oranges Oranges Oranges Oranges Oranges
    22 Apples Apples Apples Apples Apples

    30 Apples Apples Apples Apples Apples
    31 Oranges Oranges Oranges Oranges Oranges
    32 Plumbs Plumbs Plumbs Plumbs Plumbs

    Wednesday, November 4, 2015 11:27 PM

Answers

  •               

    Still not sure how you want it sorted based on actual values..... but try this.

    Sub Test3()

        Dim R As Range

        Set R = Range("A1").CurrentRegion
        R.Copy Range("A30")

        Set R = R(R.Rows.Count, 1).End(xlDown).CurrentRegion
        R.Copy Range("A30").Offset(Range("A30").CurrentRegion.Rows.Count)


        Set R = R(R.Rows.Count, 1).End(xlDown).CurrentRegion
        R.Copy Range("A30").Offset(Range("A30").CurrentRegion.Rows.Count)

    End Sub



    Friday, November 6, 2015 12:23 AM

All replies

  •         

    This will create the unsorted list - not sure if your values are really all the same in every row....

    Sub Test()

        Dim R As Range

        Set R = Range("A1")
        Range(R, R.End(xlToRight)).Copy R.End(xlDown)(2)

        Set R = R.End(xlDown)
        Range(R, R.End(xlToRight)(2)).Copy R(2).End(xlDown)(2)

        Set R = R(2).End(xlDown)
        Range(R, R.End(xlToRight)(3)).Copy Range("A30")

    End Sub

    Or just create it at the final place

    Sub Test2()

        Dim R As Range
        
        Set R = Range("A1")
        Range(R, R.End(xlToRight)).Copy Range("A30")
        
        Set R = R.End(xlDown)
        Range(R, R.End(xlToRight)).Copy Range("A31")
        
        Set R = R.End(xlDown)
        Range(R, R.End(xlToRight)).Copy Range("A32")

    End Sub

    Thursday, November 5, 2015 2:07 PM
  • Thanks. It doesn't quit work if more rows of fruit are added. For example adding bananas to row 2 or in A2. It now leaves off Plumbs from the list starting on row A30. Also, there should be blanks between rows of fruit. I tried to include the excel rows and columns numbering but hopefully didn't cause confusion. The script needs to be dynamic depending on the number of rows that are added in any section and then show up on the table starting on A30. It seems a do loop or for next loop is needed. If a bananas row and cherries row are added to A2 and A3, respectively, then starting on row A30 would show Apples, A31 Bananas, A32 Cherries, A33 Oranges, and A34 Plumbs. Thanks.
    Thursday, November 5, 2015 9:01 PM
  •               

    Still not sure how you want it sorted based on actual values..... but try this.

    Sub Test3()

        Dim R As Range

        Set R = Range("A1").CurrentRegion
        R.Copy Range("A30")

        Set R = R(R.Rows.Count, 1).End(xlDown).CurrentRegion
        R.Copy Range("A30").Offset(Range("A30").CurrentRegion.Rows.Count)


        Set R = R(R.Rows.Count, 1).End(xlDown).CurrentRegion
        R.Copy Range("A30").Offset(Range("A30").CurrentRegion.Rows.Count)

    End Sub



    Friday, November 6, 2015 12:23 AM
  • Ok. Works great! Thanks! The code provided works with a macro to eliminate duplicates.

    One more wrinkle, is it possible to write the code where it skips rows with blanks even through there are formulas within the cells/rows? Example row 2 might be visibly blank or even show zeros but they have formulas and they get copied as blanks to the table starting on A30. This causes a problem since the actual spreadsheet will encompass hundreds of rows to copy and even more blank rows and each spreadsheet will be different based on the data.

    Friday, November 6, 2015 10:19 PM
  • In that case, the best solution is to insert a column of formulas that displays either of two values, based on the status of the data, which can be used to filter the source and hide values that should not be copied. The formula required would be of the form

    =IF(some condition or conditions,"Copy","Hide")

    and then the macro would insert the column, insert the formulas, hide the rows with "Hide" and copy all the rest.  The key is finding the correct formula.

    Saturday, November 7, 2015 3:07 AM