excel vba that moves over merged cells

[BORUCH]

hi all

i have a data set that looks like below

Book1
	A	B	C	D	E	F	G	H	I	J
1	Item #	Description	qty	price	qty	price	qty	price	qty	price
2	00000	test 1	10	$12.00	20	$11.00	30	$10.00
3	00001	test 2
4	00002	test 3
5
6	00004	test 5	9	$13.00	25	$9.00
7	00005	test 6
8	00006	test 7
9
10	00008	test 9	10	$14.00	20	$15.66	30	$14.00	40	$13.00
Sheet1

i would like an excel vba that does this below

Book1
	M	N	O	P	Q	R	S	T	U	V	W	X
1	Item #	Description	qty	price	qty	price	qty	price	qty	price
2	00000	test 1	10	$12.00	20	$11.00			30	$10.00
3	00001	test 2
4	00002	test 3
5
6	00004	test 5	10	$13.00			25	$9.00
7	00005	test 6
8	00006	test 7
9
10	00008	test 9	10	$14.00	20	$15.66	30	$14.00			40	$13.00
Sheet1

as you can see it moved over every group to the right

any suggestions is greatly appreciated

 

[BORUCH]

All you have to do is change A2 to A13 in the myAreas line from Post #5.

I am done because your last post is just a copy, quote, from the previous post for no reason what-so-ever in my mind. Like I mentioned previously. One way to clutter the world.

Set myAreas = sh1.Range("A12:A" & lr).SpecialCells(2).Areas Getting error no cells found

 

[jolivanes]

Where did you find A12 in my suggestion?
Everything works properly here so you have something that we don't know about. Did you change the Sheet name?
Show us your whole macro without using the quote button again.

 

[BORUCH]

Where did you find A12 in my suggestion?
Everything works properly here so you have something that we don't know about. Did you change the Sheet name?
Show us your whole macro without using the quote button again.

Sub Try_So()
Dim myAreas As Areas
Dim sh1 As Worksheet
Dim lr As Long, i As Long, lc As Long, fcel As Long, lcel As Long
Set sh1 = ThisWorkbook.Sheets("Sheet1") '<---- Change as required
lr = sh1.Cells(Rows.count, 1).End(xlUp).Row
Set myAreas = sh1.Range("A13:A" & lr).SpecialCells(2).Areas
For i = 1 To myAreas.count
fcel = myAreas(i).Cells(1).Row
lcel = fcel + myAreas(i).Rows.count - 1
lc = Rows(fcel & ":" & lcel).Find("*", , , , 2, 2).Column
myAreas(i).Offset(, lc - 2).Resize(, 2).Insert Shift:=xlToRight
Next i
End Sub

 

[jolivanes]

What is in Column A? Keyboard entered data?

I hope by now you disabled the quote button.

Just to try something on a copy of your workbook.

Sub Try_So_Sheet1()
Dim myAreas As Areas
Dim sh1 As Worksheet
Dim lr As Long, i As Long, lc As Long, fcel As Long, lcel As Long
Set sh1 = ThisWorkbook.Sheets("Sheet1")    '<---- Change as required
lr = sh1.Cells(Rows.Count, 2).End(xlUp).Row
Set myAreas = sh1.Range("B13:B" & lr).SpecialCells(2).Areas
    For i = 1 To myAreas.Count
        fcel = myAreas(i).Cells(1).Row
        lcel = fcel + myAreas(i).Rows.Count - 1
        lc = Rows(fcel & ":" & lcel).Find("*", , , , 2, 2).Column
        myAreas(i).Offset(, lc - 3).Resize(, 2).Insert Shift:=xlToRight
    Next i
End Sub

 

[BORUCH]

Columns A,B,C,D,E, is all keyboard entered data
tried your code in post #14
im still getting error no cells found i'm using the data set i posted in post #9

 

[jolivanes]

If you go to Post #9, on the top example, the example that shows the set-up before macro is run, and click on the little sign left of the A above the 1 so you copy the data.
It should show that you copied the data. Now open a new workbook and in Sheet1 select cell A1, right click and select PasteSpecial and now select "Text".
Copy the code from Post #14 and paste it into Module 1.
Go back to Sheet1 and run the macro. Does it work now because that are the steps I've used and everything works as required.
If that does not work, upload your workbook to a free sharing site like dropbox and let us know the password to collect it.

 

[BORUCH]

If you go to Post #9, on the top example, the example that shows the set-up before macro is run, and click on the little sign left of the A above the 1 so you copy the data.
It should show that you copied the data. Now open a new workbook and in Sheet1 select cell A1, right click and select PasteSpecial and now select "Text".
Copy the code from Post #14 and paste it into Module 1.
Go back to Sheet1 and run the macro. Does it work now because that are the steps I've used and everything works as required.
If that does not work, upload your workbook to a free sharing site like dropbox and let us know the password to collect it.

hi tried exactly that and got an error no cells found

 

[jolivanes]

It might be an Excel version problem. I have never heard of it before that it could be because it works like a charm here on Excel 2013.
All I can think of is to upload it to dropbox for people to look at.
Maybe someone else knows what the problem is.

 

[BORUCH]

It might be an Excel version problem. I have never heard of it before that it could be because it works like a charm here on Excel 2013.
All I can think of is to upload it to dropbox for people to look at.
Maybe someone else knows what the problem is.

how about you change your vba to just select those last two merged cells so we can see what its selecting

 

[BORUCH]

It might be an Excel version problem. I have never heard of it before that it could be because it works like a charm here on Excel 2013.
All I can think of is to upload it to dropbox for people to look at.
Maybe someone else knows what the problem is.

hi
i changed this code line

Set sh1 = ThisWorkbook.Sheets("Sheet1")    '<---- Change as required

to this

Set sh1 = ActiveWorkbook.ActiveSheet

it worked thanks