PDA

View Full Version : Hiding, Copying and pasting in a specific order



gitmaster
08-25-2010, 07:56 AM
This might be an advanced macro, or it might not even be able to be done, but here it goes.:think:

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.
:banghead:

mdmackillop
08-25-2010, 11:22 AM
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"

gitmaster
08-25-2010, 01:11 PM
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?

mdmackillop
08-25-2010, 02:08 PM
For the first part try this. Note that single numbers between gaps show twice.


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

gitmaster
08-26-2010, 05:41 AM
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!

mdmackillop
08-26-2010, 12:11 PM
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

gitmaster
08-26-2010, 12:51 PM
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.

mdmackillop
08-26-2010, 01:17 PM
Adding blank rows changes/complicates the problem. I can't test all scenarios. Try to figure out the issues.
This is my test sample