Data Transfer Loop

[rjplante]

I have two tabs in my worksheet. Sheet 1 is my Master sheet with several columns of data. I would like to select a column and then starting at row 2, go to the first non blank cell below row 2, and then transfer the data in column A to sheet 2 (Chart page) to cell A3, then transfer the current column of data in the active row on the Master page to B3 and the first column to the right of my active column on the Master page to C3. Then I want to go to the next non blank cell on the Master page, and do the same transfer to A4, B4, and C4 on the chart page. I would like to continue all the way down to the last row on the Master sheet.

In my code below the macro crashes on the "StartRow = Sheets("Chart").Rows(3)" with a Run-Time Error 13, Type Mismatch. What do I need to do to fix this. Secondly will the rest of the code do what I describe above?

Thanks for the help.

Sub Group_Transfer()

Application.ScreenUpdating = False

Dim LastRow As Long
Dim sht As Worksheet
Dim MyCol As Long
Dim iCounter As Long
Dim MyRange As Range
Dim StartRow As Long
Dim n As Long

MyCol = ActiveCell.Column
Set sht = ActiveSheet
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Set MyRange = Rows("3:" & LastRow)
StartRow = Sheets("Chart").Rows(3)

'   Column Heading Transfer
    Sheets("Chart").Range("K2").Value = Sheets("Master").Range(ActiveCell.Column & "1").Value
    Sheets("Master").Range(MyCol & "2").Select

'   Start looping through the range.
    For iCounter = MyRange.Rows.Count To LastRow Step ActiveCell.End(xlDown).Row
    
    For n = 0 To LastRow
'   Data transfer
        Sheets("Chart").Range("A" & StartRow + n).Value = Sheets("Master").Range("A" & ActiveCell.Row).Value
        Sheets("Chart").Range("B" & StartRow + n).Value = Sheets("Master").Range(MyCol & ActiveCell.Row).Value
        Sheets("Chart").Range("C" & StartRow + n).Value = Sheets("Master").Range(MyCol + 1 & ActiveCell.Row).Value
    Next n
     
    Next iCounter
    

Application.ScreenUpdating = True

End Sub

 

[DanteAmor]

I'm afraid your macro has other problems.
But I explain the first error that appears:
You declared the variable StartRow as Long and you are setting a range, so it sends you the "Type Mismatch " error.

Dim StartRow As Long
StartRow = Sheets("Chart").Rows(3)
'To avoid the error it could be like this:
StartRow = Sheets("Chart").Rows(3).Row

_______________________________________________________________________
Try this:

You must run the macro on the "master" sheet.
The "chart" sheet should be empty.

Sub Group_Transfer()
  Dim myCol As Long, lr As Long
  myCol = ActiveCell.Column
  lr = Range("A" & Rows.Count).End(3).Row
  With Sheets("Chart")
    'Heading Transfer
    .Range("A2").Value = Range("A1")
    .Range("B2").Value = Cells(1, myCol)
    .Range("C2").Value = Cells(1, myCol + 1)
    
    'Data Transfer
    .Range("A3").Resize(lr - 1).Value = Range("A2:A" & lr).Value
    .Range("B3").Resize(lr - 1).Value = Range(Cells(2, myCol), Cells(lr, myCol)).Value
    .Range("C3").Resize(lr - 1).Value = Range(Cells(2, myCol + 1), Cells(lr, myCol + 1)).Value
  End With
End Sub

 

[rjplante]

Dante,

Thanks for your code rework. It works but my data set has gaps. So when I am in myCol, each row may or may not have data in it. What I need the code to do is end(xlDown) from the current row with data to the next row with data and then transfer the data to the chart page. In the end I hope to have my chart display only the rows with data in them for that column. How do I adjust your data transfer block to accomplish this?

 

[DanteAmor]

What I need the code to do is end(xlDown) from the current row with data to the next row with data and then transfer the data to the chart page.

I did not understand.
You can put an example with generic data. Where you are going to put the cursor and then with some color show me what data you want to copy.
Use XL2BB tool.

 

[rjplante]

Dante,

My worksheet is included below. In this example, myCol would be Column H.

Code Test WS.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	JOB #	Phase 1		Phase 2		Phase 3		Phase 4		Phase 5		Phase 6
2		Start Date	End Date	Start Date	End Date	Start Date	End Date	Start Date	End Date	Start Date	End Date	Start Date	End Date
3	111	16-Mar-2020	8-Apr-2020			16-Mar-2020	18-Mar-2020	23-Mar-2020	27-Mar-2020	6-Apr-2020	28-Jul-2020	30-Mar-2020	3-Apr-2020
4	222	23-Mar-2020	20-May-2020			6-Apr-2020	16-Apr-2020	20-Apr-2020	25-Apr-2020	27-Apr-2020	25-Nov-2020	11-May-2020	15-May-2020
5	333
6	444
7	555
8	666
9	777
10	888
11	999
12	AAA
13	BBB
14	CCC	5-Dec-2020	21-Jan-2021			16-Dec-2020	20-Dec-2020	26-Dec-2020	3-Jan-2021	6-Jan-2020	10-Jun-2020	13-Jan-2020	17-Jan-2020
15	DDD
16	EEE	9-Jan-2020	4-Mar-2020			20-Jan-2020	28-Jan-2020	30-Jan-2020	7-Feb-2020	17-Feb-2020	14-Jul-2020	24-Feb-2020	28-Feb-2020
17	FFF	8-Jan-2020	11-Feb-2020			15-Jan-2021	17-Jan-2021	20-Jan-2020	24-Jan-2020	3-Feb-2020	28-May-2020	3-Feb-2020	7-Feb-2020
18	GGG	26-Feb-2020	8-Apr-2020			9-Mar-2020	13-Mar-2020	16-Mar-2020	20-Mar-2020	30-Mar-2020	9-Sep-2020	6-Apr-2020	10-Apr-2020
19	HHH
20	III
21	JJJ
22	KKK
23	LLL
24	MMM
25	NNN
26	OOO
27	PPP
28	QQQ
29	RRR	9-Sep-2020	5-Nov-2020			16-Sep-2020	25-Sep-2020	7-Oct-2020	11-Oct-2020	21-Oct-2019	8-Apr-2020	10/28-11/1
30	SSS
31	TTT
32	UUU
33	VVV	5-Feb-2020	25-Mar-2020			17-Feb-2020	21-Feb-2020	25-Feb-2020	28-Feb-2020	9-Mar-2020	5-Aug-2020	3/16-3/20
34	WWW	12-Feb-2020	27-May-2020	11-Mar-2020	8-Apr-2020	12-Mar-2020	24-Mar-2020	8-Apr-2020	15-Apr-2020	13-Apr-2020	13-Jan-2021	5/18-5/22
35	XXX
36	YYY
37	ZZZ
Master

I want to have it pasted into the chart page like this (but have the start and end date added in of course.

Code Test WS.xlsm
	A	B	C
2	JOB #	Start Date	End Date
3	111
4	222
5	ccc
6	eee
7	fff
8	ggg
9	rrr
10	vvv
11	www
12
13
14
15
16
17
18
19
20
Chart

Thanks.

 

[DanteAmor]

Try this

Sub Group_Transfer()
  Dim sh As Worksheet, myCol As Long, lr As Long, lr2 As Long
  Application.ScreenUpdating = False
  Set sh = ActiveSheet
  myCol = ActiveCell.Column
  lr = sh.Range("A" & Rows.Count).End(3).Row
  With Sheets("Chart")
    'Heading Transfer
    .Range("A2").Value = sh.Range("A1")
    .Range("B2").Value = sh.Cells(2, myCol)
    .Range("C2").Value = sh.Cells(2, myCol + 1)
    '
    'Data Transfer
    If sh.AutoFilterMode Then sh.AutoFilterMode = False
    If .AutoFilterMode Then .AutoFilterMode = False
    lr2 = .Range("A" & Rows.Count).End(3).Row + 1
    '
    sh.Range("A2", Cells(lr, myCol)).AutoFilter myCol, "<>"
    sh.AutoFilter.Range.Range("A2:A" & lr).Copy
    .Range("A" & lr2).PasteSpecial xlPasteValues
    sh.AutoFilter.Range.Range(sh.Cells(2, myCol), sh.Cells(lr, myCol + 1)).Copy
    .Range("B" & lr2).PasteSpecial xlPasteValues
    sh.ShowAllData
  End With
  Application.ScreenUpdating = True
End Sub

 

[rjplante]

Dante,

Thank you for the updated code. It works great. I had to do a little modification to complete the output, and it looks awesome.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.