Vba with offset copy and past

[bboysen]

Hello all.

I am having a problem with my code.
Here is what i am trying to do.

Lets say i have data in rows R1C1, R3C1 AND R5C1. I have hidden rows 2,4. Now I want to copy the info from R1C1 to R3C2. My problem happens with the hidden rows. It will copy with the offset of (0, -1) from the selected cell of R3C2, but will paste it in R2C2 when I use the offset of (1, 0).

I have looked all over the internet and know I am missing one little thing but can't seem to pinpoint the problem.

I have add my simple code to this post please let me know where I have gone wrong!

Thanks

Sub OFFSETCOPY()'
'
'SELECT AND COPY ONE C UP AND ONE R LEFT OF CURRENT SELECTION
ActiveCell.Offset(0, -1).Select
    Selection.Copy
    Do
ActiveCell.Offset(1, 0).Select
     Loop While ActiveCell.EntireRow.Hidden = True
'SELECT AND PAST ONE C DOWN AND ONE R RIGHT OF CURRENT SELECTION
    ActiveSheet.PASTE
End Sub

 

[JLGWhiz]

Your example would probably give you an error message since you are trying to offset from column A to the left. But I think I understand what you are saying. Excel still sees the rows and columns although the user may have hidden them.

With VBA you need to tell Excel to ignore the hidden rows or columns. Try this modified version. It assumes that your worksheet is sheet1. If not, make the appropriate change to the With statement.

Code:
Sub OFFSETCOPY2()'
'SELECT AND COPY ONE C UP AND ONE R LEFT OF CURRENT SELECTION
With Sheets(1).SpecialCells(xlCellTypeVisible)
ActiveCell.Offset(0, -1).Select
Selection.Copy
Do
ActiveCell.Offset(1, 0).Select
Loop While ActiveCell.EntireRow.Hidden = True
'SELECT AND PAST ONE C DOWN AND ONE R RIGHT OF CURRENT SELECTION
ActiveSheet.Paste
End With
End Sub
Code:

 

[bboysen]

Thanks that worked had to make a few tweaks to it but got it to go!

Do you think you could help me with an if statement for it to work only on rows that contain the word weld?

What I have is this:

Excel 2010

	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Point ID	Northing	Easting	Elevation	Feature Code	Latitude (Local)	Longitude (Local)	Attributes 1	Attributes 2	Attributes 3	Attributes 4	Attributes 5	Attributes 6
2	206146	16716330.99	1830753.758	3313.547	LE	46.00745	-104.25067	1168-1	F40520
5	206149	16716260.91	1830751.853	3316.922	WELD	46.00726	-104.25068	F2ML-768	1016-9	1168-1	28.3	R42324	1016
8	206152	16716232.59	1830751.318	3318.787	WELD	46.00718	-104.25068	F2ML-769	1036-9	1016-9	45.9	F40320	1036
14	206158	16716187.53	1830750.718	3323.865	WELD	46.00705	-104.25068	F2ML-770	1018-9	1036-9	21.2	F40319	1018
16	206159	16716166.38	1830750.383	3325.947	WELD	46.007	-104.25068	F2ML-771	1018-9B	1018-9	20.9	F40319	1018
19	206163	16716145.48	1830749.979	3327.325	WELD	46.00694	-104.25069	F2ML-772	1013-8	1018-9B	18.3	R42247	1013
20	206164	16716127.34	1830749.669	3328.03	WELD	46.00689	-104.25069	F2ML-773	1013-8B	1013-8	18	R42247	1013
22	206165	16716109.41	1830749.132	3328.651	WELD	46.00684	-104.25069	F2ML-774	1013-8D	1013-8B	9	R42247	1013
23	206167	16716100.49	1830748.986	3328.894	WELD	46.00682	-104.25069	F2ML-775	1015-5	1013-8D	49	R42324	1015
24	206168	16716051.53	1830747.844	3329.948	WELD	46.00668	-104.2507	F2ML-776	1082-4	1015-5	52.8	F40521	1082
26	206169	16715998.72	1830746.932	3331.266	WELD	46.00654	-104.2507	F2ML-777	1095-8	1082-4	21.2	F40522	1095
27	206171	16715977.65	1830746.69	3331.822	WELD	46.00648	-104.25071	A2C2F2ML-778NW	1095-8B	1095-8	37	F40522	1095
28	206172	16715940.71	1830745.968	3332.923	WELD	46.00638	-104.25071	F2ML-779	1000-4	1095-8B	75.3	R42245	1000
30	206173	16715865.49	1830744.74	3336.127	WELD	46.00617	-104.25072	F2ML-780	993-6	1000-4	75.7	R42243	993
31	206175	16715791.09	1830743.608	3340.857	WELD	46.00597	-104.25073	F2ML-781	1021-2	993-6	78.2	R42248	1021
36	206180	16715713.4	1830743.015	3347.726	WELD	46.00575	-104.25073	F2ML-782	369-5	1021-2	60.5	R43792	369
37	206181	16715644.17	1830741.363	3353.35	WELD	46.00556	-104.25074	F2ML-783	375-3	369-5	76.2	R43792	375
39	206182	16715568.2	1830739.822	3357.615	WELD	46.00536	-104.25075	A2C2F2ML-784NW	333-6	375-3	71.6	F41756	333
40	206184	16715496.7	1830738.641	3360.608	WELD	46.00516	-104.25076	F2ML-785	372-5	333-6	70.6	R43792	372
41	206185	16715426.12	1830737.457	3362.825	WELD	46.00497	-104.25076	F2ML-786	372-2	372-5	66.5	R43792	372
44	206188	16715359.7	1830736.156	3365.936	WELD	46.00478	-104.25077	F2ML-787	363-3	372-2	75	R43792	363
45	206189	16715284.99	1830734.486	3369.276	WELD	46.00458	-104.25078	F2ML-788	362-4	363-3	62.8	R43792	362
48	206192	16715223.99	1830733.556	3370.262	WELD	46.00441	-104.25079	F2ML-789	328-8	362-4	75.4	F41756	328
49	206193	16715148.53	1830732.895	3370.012	WELD	46.0042	-104.25079	F2ML-790	346-6	328-8	77.1	F41757	346
51	206194	16715071.62	1830733.635	3369.029	WELD	46.00399	-104.25079	C2F2ML-791R	374-4	346-6	76.5	R43792	374
54	206198	16714995.34	1830734.716	3369.695	WELD	46.00378	-104.25079	F2ML-792	361-5	374-4	76.9	R43792	361
56	206199	16714918.68	1830735.778	3372.646	LE	46.00357	-104.25079	361-5	R43792

<tbody>
</tbody>

​

Now remember I have hidden Info between the welds.

Also here is my updated Code

Sub WELD()

finalrow = ActiveSheet.UsedRange.Rows.Count


Count = 1
For r = 2 To finalrow
    With ActiveCell.SpecialCells(xlCellTypeVisible)
    ActiveCell.Offset(0, 3).Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-4],SEARCH(""-"",RC[-4])-1)"
    ActiveCell.Offset(0, -4).Select
    Selection.Copy
    Do
    ActiveCell.Offset(1, 0).Select
    Loop While ActiveCell.EntireRow.Hidden = True
    ActiveCell.Offset(0, 1).Select
    ActiveSheet.PASTE
    End With
    
Next r


End Sub

And how would you get it to stop at row 56 and not go any further?

Thanks for your help