• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy Data from columns and paste in rows by inserting rows [SOLVED]

K

KapardhiSarma

New Member
I never programed an excel macro, i'm facing a problem i hope excel macro can solve it, because i have huge amounts of data that need filtering its simple i will explain in an example

Original Table:
Column A Column B Column C Column D
name1 123456789
name2 234567783 3456677889
name3 213123123
name4 123451231 123412312 1231223523

what macro need to do is when he finds data in the third column or forth or both he insert a new row and put the fill it with the name from the column and the number from the third coloum so data will be like that

How table is supposed to be:
name1 123456789 (stays the same no data in colum3 or 4)
name2 234567783 (removes the third column data and put it in a new row)
name2 3456677889 (keeping the name that the data had)
name3 213123123 (stays the same no data in colum 3 or 4)
name4 123451231 (removes the third column data and forth colum data and put it in new rows)
name4 123412312
name4 1231223523

I am currently using the below code, but please help me how to get started from column B?

Code: 
Sub test2()

Dim r As Range, x As Long, y As Long, Cnt As Long

Application.ScreenUpdating = False '**faster

With ActiveSheet 'specify actual sheet
    Cnt = .Cells(.Rows.CountLarge, 1).End(xlUp).Row 'last non blank cell in column A
'   rows loop
    For y = Cnt To 1 Step -1 'start at last row and work up
        Set r = .Range(.Cells(y, 1), .Cells(y, .Columns.Count).End(xlToLeft)) 'current row
'       loop thru cells in current row

        If Not IsEmpty(r(1)) Then '** skip empty cell

          For x = r.Cells.Count To 3 Step -1
             r.Offset(1).EntireRow.Insert Shift:=xlDown 'insert row
             r(x).Cut r(2).Offset(1) 'number to column B
             r(1).Offset(1).Value = r(1).Value 'name to column A
         Next x
       End If '**
    Next y
End With

Application.ScreenUpdating = True '**

End Sub
 
Last edited by a moderator:
iferror said:
I do not understand...your macro works like a charm...what is it that you're trying to do here?
Click to expand...

The issue is its not working, excel and VBA are not responding once started executing.
Please see my further explanation below.

Column A Column B Column C Column D Column E
XXX name1 123456789
XXX name2 234567783 3456677889
YYY name3 213123123
YYY name4 123451231 123412312 1231223523

When the macro runs, it should start from column c, if adjacent row of column c is blank it should skip and move to next row.
If found data in column d, insert a new row and move data from column d to new column.
If data is found in 2 columns after column c, it should add two rows below and insert the data in column c, column A and B should be the same when a new row is inserted.

Hope this clarifies.
 
Last edited:
Assuming that this is the starting point
Code: 
xxx aaa 1 2 3 4
xxx sss 1 2
xxx ddd 2

yyy ggg 3 4
yyy hhh 3 5
yyy jjj 2 3 4 5
zzz kkk 3
zzz lll 4 5
zzz rrr 5
xxx vvv
zzz mmm 1 2 3

and this is your goal

Code: 
xxx aaa 1
xxx aaa 2
xxx aaa 3
xxx aaa 4
xxx sss 1
xxx sss 2
xxx ddd 2

yyy ggg 3
yyy ggg 4
yyy hhh 3
yyy hhh 5
yyy jjj 2
yyy jjj 3
yyy jjj 4
yyy jjj 5
zzz kkk 3
zzz lll 4
zzz lll 5
zzz rrr 5
xxx vvv
zzz mmm 1
zzz mmm 2
zzz mmm 3

this is the macro that suits your request
Code: 
Sub test2()

Dim r As Range, x As Long, y As Long, Cnt As Long

Application.ScreenUpdating = False '**faster

With ActiveSheet 'specify actual sheet
Cnt = .Cells(.Rows.CountLarge, 1).End(xlUp).Row 'last non blank cell in column A
' rows loop
For y = Cnt To 1 Step -1 'start at last row and work up
Set r = .Range(.Cells(y, 1), .Cells(y, .Columns.Count).End(xlToLeft)) 'current row
' loop thru cells in current row

If Not IsEmpty(r(1)) Then '** skip empty cell

For x = r.Cells.Count To 4 Step -1
r.Offset(1).EntireRow.Insert Shift:=xlDown 'insert row
r(x).Cut r(3).Offset(1) 'number to column C
r(1).Offset(1).Value = r(1).Value 'name to column A
r(2).Offset(1).Value = r(2).Value 'name to column B
Next x
End If '**
Next y
End With

Application.ScreenUpdating = True '**

End Sub
 
iferror said:
Assuming that this is the starting point
Code: 
xxx aaa 1 2 3 4
xxx sss 1 2
xxx ddd 2

yyy ggg 3 4
yyy hhh 3 5
yyy jjj 2 3 4 5
zzz kkk 3
zzz lll 4 5
zzz rrr 5
xxx vvv
zzz mmm 1 2 3

and this is your goal

Code: 
xxx aaa 1
xxx aaa 2
xxx aaa 3
xxx aaa 4
xxx sss 1
xxx sss 2
xxx ddd 2

yyy ggg 3
yyy ggg 4
yyy hhh 3
yyy hhh 5
yyy jjj 2
yyy jjj 3
yyy jjj 4
yyy jjj 5
zzz kkk 3
zzz lll 4
zzz lll 5
zzz rrr 5
xxx vvv
zzz mmm 1
zzz mmm 2
zzz mmm 3

this is the macro that suits your request
Code: 
Sub test2()

Dim r As Range, x As Long, y As Long, Cnt As Long

Application.ScreenUpdating = False '**faster

With ActiveSheet 'specify actual sheet
Cnt = .Cells(.Rows.CountLarge, 1).End(xlUp).Row 'last non blank cell in column A
' rows loop
For y = Cnt To 1 Step -1 'start at last row and work up
Set r = .Range(.Cells(y, 1), .Cells(y, .Columns.Count).End(xlToLeft)) 'current row
' loop thru cells in current row

If Not IsEmpty(r(1)) Then '** skip empty cell

For x = r.Cells.Count To 4 Step -1
r.Offset(1).EntireRow.Insert Shift:=xlDown 'insert row
r(x).Cut r(3).Offset(1) 'number to column C
r(1).Offset(1).Value = r(1).Value 'name to column A
r(2).Offset(1).Value = r(2).Value 'name to column B
Next x
End If '**
Next y
End With

Application.ScreenUpdating = True '**

End Sub
Click to expand...
Fantastic...its awesome!!! :D
 
You must log in or register to reply here.
Back
Top