A macro to copy & paste many rows (a range) to the next column ..

Hi Per,
I aplogoize for not grapsing the intricacies here. Yes, the macro worked
wonderfully. I did not realize that the macro was dependent so much on the
exact way my table was arranged. Once I sorted and ran, it ran wonderfully.
Thank you so much Per
You have saved me hours !!
-GH

"Per Jessen" wrote:

Hi GH

When the error occur, try to click Debug, and see which line is highlighted.

Also try to look at Sheet1 to verify that the filter is applied.

Have you made any changes to the code?

-Per

"genehunter" skrev i meddelelsen
...
Hi Per,
I use Notetab++ for checking about the wordwrap. But I am still stuck with
the following message:
Run-time error '1004':
Method 'ShowAllData' of object '_Worksheet' failed.
Any help would be very very appreciated.
Thanks for helping so far.
Regards
-GH

"Per Jessen" wrote:

Hi GH

You are as many others a victim of word wrap in your editor. The
statement
mentioned is a part of the line above. To fix it remove the carriage
return
between the two lines (remeber to insert a space).

Hopes this helps.

-Per

"genehunter" skrev i meddelelsen
...
Hi Per,
I pasted your code to the VB editor.
I get the following msg:
Sub AAA() is shown in Yellow
then
TargetSh.Range("A1").Offset(0, Off) is shown in Red
When I run it shows Compile error, syntax error.

I dont know VB so I am really sorry to ask you to hold my hands through
this.
Thank you
GH
"Per Jessen" wrote:

OK now I get it.

This will copy from sheet1 to sheet2.

Sub AAA()
Dim FilterRange As Range
Dim AssayRange As Range
Dim TableRange As Range
Dim Off As Long
Dim TargetSh As Worksheet
Dim InputSh As Worksheet
Dim AssayArr()

Set InputSh = Worksheets("Sheet1")
Set TargetSh = Worksheets("Sheet2")
LastRow = InputSh.Range("B" & Rows.Count).End(xlUp).Row
Set FilterRange = InputSh.Range("B1:B" & LastRow)
Set TableRange = InputSh.Range("A1", InputSh.Range("D" & LastRow))
FilterRange.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set AssayRange = FilterRange.SpecialCells(xlCellTypeVisible)

InputSh.ShowAllData

ReDim AssayArr(AssayRange.Cells.Count)
For Each c In AssayRange.Cells
COunter = COunter + 1
AssayArr(COunter) = c.Value
Next

For x = 2 To UBound(AssayArr)
TableRange.AutoFilter Field:=2, Criteria1:=AssayArr(x)
TableRange.SpecialCells(xlCellTypeVisible).Copy
TargetSh.Range("A1").Offset(0, Off)
Off = Off + 4
Next
TableRange.AutoFilter
End Sub

Best regards,
Per

"genehunter" skrev i
meddelelsen
...
Hi, I am sorry I made a mistake when mentioning the filtering on
Col
C,
its
actually B. So what I am trying to do is to get all the 4 columns A,
B,
C
and
D for each unique value in Col B to be pasted to the next 4 columns
(i.e.
E
thru H) and so on.
Since I am applying filter, I am pasting to another sheet at the
moment.
Here is an example input and output.
INPUT:
WELL_POSITION ASSAY_ID Alpha SAMPLE_ID
A01 Statin1 C 1
A02 Statin1 C 2
A03 Statin1 C 3
A04 Statin1 C 4
A05 Statin1 CT 5
A06 Statin1 C 6
A07 Statin1 CT 7
A01 Statin2 C 1
A02 Statin2 C 2
A03 Statin2 C 3
A04 Statin2 C 4
A05 Statin2 C 5
A06 Statin2 TC 6
A07 Statin2 C 7
A01 Statin3 G 1
A02 Statin3 G 2
A03 Statin3 G 3
A04 Statin3 G 4
A05 Statin3 G 5
A06 Statin3 G 6
A07 Statin3 AG 7

Output:

WELL_POSITION ASSAY_ID Alpha SAMPLE_ID WELL_POSITION ASSAY_ID Alpha
SAMPLE_ID WELL_POSITION ASSAY_ID Alpha SAMPLE_ID
A01 Statin1 C 1 A01 Statin2 C 1 A01 Statin3 G 1
A02 Statin1 C 2 A02 Statin2 C 2 A02 Statin3 G 2
A03 Statin1 C 3 A03 Statin2 C 3 A03 Statin3 G 3
A04 Statin1 C 4 A04 Statin2 C 4 A04 Statin3 G 4
A05 Statin1 CT 5 A05 Statin2 C 5 A05 Statin3 G 5
A06 Statin1 C 6 A06 Statin2 TC 6 A06 Statin3 G 6
A07 Statin1 CT 7 A07 Statin2 C 7 A07 Statin3 AG 7

Hi GH,
Thanks for your reply, I'm glad you made it work.

I have added a sort on columns B and D, so you don't have to do that
manually.

Sub AAA()
Dim FilterRange As Range
Dim AssayRange As Range
Dim TableRange As Range
Dim Off As Long
Dim TargetSh As Worksheet
Dim InputSh As Worksheet
Dim AssayArr()

Set InputSh = Worksheets("Sheet1")
Set TargetSh = Worksheets("Sheet2")
LastRow = InputSh.Range("B" & Rows.Count).End(xlUp).Row
Set FilterRange = InputSh.Range("B1:B" & LastRow)
Set TableRange = InputSh.Range("A1", InputSh.Range("D" & LastRow))
TableRange.Sort Key1:=Range("B2"), Order1:=xlAscending, _
Key2:=Range("D2"), Order2:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
FilterRange.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set AssayRange = FilterRange.SpecialCells(xlCellTypeVisible)

InputSh.ShowAllData

ReDim AssayArr(AssayRange.Cells.Count)
For Each c In AssayRange.Cells
COunter = COunter + 1
AssayArr(COunter) = c.Value
Next

For x = 2 To UBound(AssayArr)
TableRange.AutoFilter Field:=2, Criteria1:=AssayArr(x)
TableRange.SpecialCells(xlCellTypeVisible).Copy _
Destination:=TargetSh.Range("A1").Offset(0, Off)
Off = Off + 4
Next
TableRange.AutoFilter
End Sub

Best wishes
Per

"genehunter" skrev i meddelelsen
...
Hi Per,
I aplogoize for not grapsing the intricacies here. Yes, the macro worked
wonderfully. I did not realize that the macro was dependent so much on the
exact way my table was arranged. Once I sorted and ran, it ran
wonderfully.
Thank you so much Per
You have saved me hours !!
-GH

"Per Jessen" wrote:

Hi GH

When the error occur, try to click Debug, and see which line is
highlighted.

Also try to look at Sheet1 to verify that the filter is applied.

Have you made any changes to the code?

-Per

"genehunter" skrev i meddelelsen
...
Hi Per,
I use Notetab++ for checking about the wordwrap. But I am still stuck
with
the following message:
Run-time error '1004':
Method 'ShowAllData' of object '_Worksheet' failed.
Any help would be very very appreciated.
Thanks for helping so far.
Regards
-GH

"Per Jessen" wrote:

Hi GH

You are as many others a victim of word wrap in your editor. The
statement
mentioned is a part of the line above. To fix it remove the carriage
return
between the two lines (remeber to insert a space).

Hopes this helps.

-Per

"genehunter" skrev i
meddelelsen
...
Hi Per,
I pasted your code to the VB editor.
I get the following msg:
Sub AAA() is shown in Yellow
then
TargetSh.Range("A1").Offset(0, Off) is shown in Red
When I run it shows Compile error, syntax error.

I dont know VB so I am really sorry to ask you to hold my hands
through
this.
Thank you
GH
"Per Jessen" wrote:

OK now I get it.

This will copy from sheet1 to sheet2.

Sub AAA()
Dim FilterRange As Range
Dim AssayRange As Range
Dim TableRange As Range
Dim Off As Long
Dim TargetSh As Worksheet
Dim InputSh As Worksheet
Dim AssayArr()

Set InputSh = Worksheets("Sheet1")
Set TargetSh = Worksheets("Sheet2")
LastRow = InputSh.Range("B" & Rows.Count).End(xlUp).Row
Set FilterRange = InputSh.Range("B1:B" & LastRow)
Set TableRange = InputSh.Range("A1", InputSh.Range("D" & LastRow))
FilterRange.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set AssayRange = FilterRange.SpecialCells(xlCellTypeVisible)

InputSh.ShowAllData

ReDim AssayArr(AssayRange.Cells.Count)
For Each c In AssayRange.Cells
COunter = COunter + 1
AssayArr(COunter) = c.Value
Next

For x = 2 To UBound(AssayArr)
TableRange.AutoFilter Field:=2, Criteria1:=AssayArr(x)
TableRange.SpecialCells(xlCellTypeVisible).Copy
TargetSh.Range("A1").Offset(0, Off)
Off = Off + 4
Next
TableRange.AutoFilter
End Sub

Best regards,
Per

"genehunter" skrev i
meddelelsen
...
Hi, I am sorry I made a mistake when mentioning the filtering on
Col
C,
its
actually B. So what I am trying to do is to get all the 4 columns
A,
B,
C
and
D for each unique value in Col B to be pasted to the next 4
columns
(i.e.
E
thru H) and so on.
Since I am applying filter, I am pasting to another sheet at the
moment.
Here is an example input and output.
INPUT:
WELL_POSITION ASSAY_ID Alpha SAMPLE_ID
A01 Statin1 C 1
A02 Statin1 C 2
A03 Statin1 C 3
A04 Statin1 C 4
A05 Statin1 CT 5
A06 Statin1 C 6
A07 Statin1 CT 7
A01 Statin2 C 1
A02 Statin2 C 2
A03 Statin2 C 3
A04 Statin2 C 4
A05 Statin2 C 5
A06 Statin2 TC 6
A07 Statin2 C 7
A01 Statin3 G 1
A02 Statin3 G 2
A03 Statin3 G 3
A04 Statin3 G 4
A05 Statin3 G 5
A06 Statin3 G 6
A07 Statin3 AG 7

Output:

WELL_POSITION ASSAY_ID Alpha SAMPLE_ID WELL_POSITION ASSAY_ID
Alpha
SAMPLE_ID WELL_POSITION ASSAY_ID Alpha SAMPLE_ID
A01 Statin1 C 1 A01 Statin2 C 1 A01 Statin3 G 1
A02 Statin1 C 2 A02 Statin2 C 2 A02 Statin3 G 2
A03 Statin1 C 3 A03 Statin2 C 3 A03 Statin3 G 3
A04 Statin1 C 4 A04 Statin2 C 4 A04 Statin3 G 4
A05 Statin1 CT 5 A05 Statin2 C 5 A05 Statin3 G 5
A06 Statin1 C 6 A06 Statin2 TC 6 A06 Statin3 G 6
A07 Statin1 CT 7 A07 Statin2 C 7 A07 Statin3 AG 7