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

  • Thread starter Thread starter genehunter
  • Start date Start date
G

genehunter

Hi,
I have some data that needs to be reformatted. (see below)
The data has 4 columns, Col A ("Position"), Col B ("Assay") and Col C
("Alpha"),
Col D ("Sample ID").
I want to select "the Col B & Col D sorted data" to be copied and pasted to
the adjacent Cols-E thru H, and so on for all the different Assays (Col B)
till end of file.
Can this be done through a macro?
A present I am filtering on Col C and then copying and pasting manually for
each Assay.

e.g
WELL 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
A08 Statin1 C 8
A09 Statin1 C 9
A10 Statin1 C 10
 
Hi

I'm not sure exactly what output you expect.

Your posted data is sorted on column B, then on Column D. Now you filter on
column C and for each value in column C Copy all ASSAY_ID=Statin1 copy to
Output table or...?

Maybe a sample or your expected output data will help clarify things.

Best regards,
Per
 
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
 
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
 
Hi Simon,
Please check my second comment on the thread where I have tried to explain
again with sample data. I want to copy all the 4 columns to the next
available column, but for each range defined by the Col "Assay ID".

Say each Assay ID has about 384 rows.
So I want each of the 4 columns A, B, C & D to be copied to the next
available column (e.g. E1:H384) for AssayID: Statin1; then the next 384 rows
for columns A,B, C, D copied to columns I1:L384 for AssayID: Statin2 , and
rows corresponding to the Statin3 (in Col B) copied for A,B,C,D to Column
M1:P384 and so on till the last AssayID in Column B.
 
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
 
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
 
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
 
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
 
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
 
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
 
Back
Top