Consulting

Results 1 to 8 of 8

Thread: Hiding, Copying and pasting in a specific order

  1. #1

    Hiding, Copying and pasting in a specific order

    This might be an advanced macro, or it might not even be able to be done, but here it goes.

    I have a large spreadsheet with lots of rows and columns. The first two columns have numbers, the rest of the columns have y/n for options. I have filters on those for different scenarios. Once I select all my filters that I want, I would like a macro to copy specific information to a new page.

    In column 1, there are 6 possibilities: 10, 20, 30, 40, 50, or 60.
    In column 2, there are lots of possibilites, most are from 0010 to 6150.
    So for instance, column 1 starts at 10 and column 2 starts at 0010. Column 1 stays at 10 until column 2 reaches 6150, then column 1 goes to 20 and column 2 starts back at 10, and so forth.
    Example: (where you see ... that's just to save space for this example.)

    10 10
    10 20
    ... ...
    10 6140
    10 6150
    20 10
    20 20
    ... ...
    20 3110
    20 3120
    30 10
    30 20


    After I select my filters, obviously there will be gaps in the numbers. So instead of going from 0010 to 0100, it might go 0010-0030 then 0050-0080, then 0100.
    What I want to do is copy the data onto a seperate sheet with specific guidelines, and this is where it gets tricky.
    I want the macro to go down column two and copy the first number is comes across ( in this case, 0010) then paste it on sheet 2. Go back to sheet 1 and copy the number before the gap (in this case, 0030) and skip everything in between. Paste this on sheet 2 to the right of the first number. Go back to sheet 1 and copy the number after the gap (0050) back to sheet 2 and paste to the right. I want to continue on sheet 1 alternating between before and after the gap.
    Now, to get even more complicated.
    When pasting, I don't want any more than 8 columns out. So in the example above, it would read:

    0010 0030 0050 0080 0100 0100

    Once it hits the 8th column, I want it to go down 1 row and start over, pasting one column at a time until it hits row 8 again
    I also would like it to jump to a new row when column 1 on sheet 1 changes values. So when it goes from 10 to 20, on sheet 2 it should start a new row to paste too.
    I also would like the macro to completely stop when it hits a blank value.

    Something tells me this is very complicated, and I'm not sure it can even be done.

  2. #2
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Welcome to VBAX
    Can you repost your sample showing your filter in use and show results (maybe some colour coding?). I don't follow what you mean by "gaps"
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  3. #3
    Thanks!
    The file I attached has active filters. The 'Movie' column is currently set to show only cells with a 'y'.
    By gaps, I mean those rows that are hidden due to the filters. So in the attached file, with 'Movie' set to 'y', rows 8 thru 12 are hidden, so there's a gap in the data? Does that make sense?

  4. #4
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    For the first part try this. Note that single numbers between gaps show twice.

    [VBA]
    Option Explicit
    Sub Test()
    Dim Rng As Range, Cel As Range
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim i As Long, col As Long, rw As Long
    Dim Test1 As Boolean, Test2 As Boolean
    Set ws1 = Sheets(1)
    Set ws2 = Sheets(2)
    Test1 = True
    Test2 = True
    With ws1
    Set Rng = Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp))
    For Each Cel In Rng
    If Cel.EntireRow.Hidden = False Then
    If Test1 Then
    i = i + 1
    col = i Mod 8
    If col = 0 Then col = 8
    rw = (i \ 8) + 1
    ws2.Cells(rw, col) = Cel
    End If
    Test1 = False
    Test2 = True
    Else
    If Test2 Then
    i = i + 1
    col = i Mod 8
    If col = 0 Then col = 8
    rw = (i \ 9) + 1
    ws2.Cells(rw, col) = Cel.Offset(-1)
    Test2 = False
    Test1 = True
    End If
    End If
    Next
    End With
    End Sub
    [/VBA]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  5. #5
    Ok, I tried that, but for some reason it's not picking up that last cell.
    Also, is there a way to break it up for every change in column 1?
    Thanks again for the help!

  6. #6
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    [VBA]Option Explicit
    Sub Test()
    Dim Rng As Range, Cel As Range
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim i As Long, col As Long, rw As Long
    Dim Test1 As Boolean, Test2 As Boolean
    Dim Gp As Long

    Set ws1 = Sheets(1)
    Set ws2 = Sheets(2)
    Test1 = True
    Test2 = True
    ws2.Columns(2).Interior.ColorIndex = xlNone
    ws2.Cells.Clear
    Gp = 0
    With ws1
    Set Rng = Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp))
    For Each Cel In Rng
    'If rw = 33 Then Stop
    If Cel.EntireRow.Hidden = False Then
    If Test1 Then
    If Cel.Offset(, -1) <> Gp Then
    i = i + 8 - i Mod 8
    Gp = Cel.Offset(, -1)
    End If
    i = i + 1
    col = i Mod 8
    If col = 0 Then col = 8
    rw = (i \ 8) + 1 - col \ 8
    ws2.Cells(rw, col) = Gp & "//" & Cel 'Modify to suit
    End If
    Test1 = False
    Test2 = True
    Else
    If Test2 Then
    If Cel.Offset(, -1) <> Gp Then
    i = i + 8 - i Mod 8
    Gp = Cel.Offset(, -1)
    End If
    i = i + 1
    col = i Mod 8
    If col = 0 Then col = 8
    rw = (i \ 8) + 1 - col \ 8
    ws2.Cells(rw, col) = Gp & "//" & Cel.Offset(-1) 'Modify to suit
    Test2 = False
    Test1 = True
    End If
    End If
    Next
    End With
    'Last cell
    i = i + 1
    col = i Mod 8
    If col = 0 Then col = 8
    rw = (i \ 8) + 1 - col \ 8
    Set Cel = Rng(Rng.Cells.Count)
    ws2.Cells(rw, col) = Gp & "//" & Cel 'Modify to suit
    End Sub[/VBA]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  7. #7
    I like where this is going. However, that last cell that it copies doesn't paste right? It's pasting as 10 // 3000 when it should read 40 // 3000? If I put a blank row between each change in the first column, then I get a runtime error 13.

  8. #8
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Adding blank rows changes/complicates the problem. I can't test all scenarios. Try to figure out the issues.
    This is my test sample
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •