Hi experts, I hope someone can help me with this. The excel sheet I have is full of data and it runs beyond column Z, so I need to make it shorter.

I want to insert a row under Row1 and cut&paste the value from L1:P1 to G2:K2. Then insert another row under Row2 and cut&paste the value from Q1:U1 to G3:K3. And continue doing this until ColumnBD (there are empty cells in between so I guess the range has to be strictly set).

After this, I also have to do the same thing to the original Row2 (Row11 or 12 now I guess) and the original Row3 and Row4 and one and on and on...

I have absolutely no clue right now...any help will be greatly appreciated!

Thanks!

✔ Best Answer

Final Solution, verified by requester via email: Sub NarrowData() Application.ScreenUpdating = False 'Determine how many rows we need to loop through 'Assume Column headers in Row 1 loopRws = Range("A" & Rows.Count).End(xlUp).Row - 1 'Loop through source Rows For srcRw = 3 To Rows.Count 'Determine how many Rows to Insert based on how much data is in current Row lastCol = Cells(srcRw - 1, Columns.Count).End(xlToLeft).Column dstRws = Application.WorksheetFunction.RoundDown((lastCol - 12) / 5, 0) 'If no data past Column K, no Insert needed If dstRws < 1 Then loopCnt = loopCnt + 1 GoTo NoInsert End If 'Insert Rows based on width of data in current Row Rows(srcRw & ":" & srcRw + dstRws).Insert 'Initialize variable for first Paste row dstRw = srcRw 'Cut(Copy) data to Column G For srcCol = 12 To lastCol Step 5 Range(Cells(srcRw - 1, srcCol), Cells(srcRw - 1, srcCol + 4)).Copy _ Destination:=Cells(dstRw, 7) dstRw = dstRw + 1 Next 'Set new Source Row srcRw = srcRw + dstRws + 1 'Count loops, exit when last Row has been done loopCnt = loopCnt + 1 If loopCnt = loopRws Then Exit For NoInsert: Next End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Everything makes sense except for this: "

there are empty cells in between so I guess the range has to be strictly setWhat does that mean?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

I was thinking that the macro can't just keep on running so there must be a condition to stop it, and it is likely to be when it hits the empty cell...?

I am confused. Don't listen to me. You can just take that line off and pretend that it never existed...

Code can be wriitten to stop at the last column with data, but you said "continue doing this until Column BD." However, you said something about "empty cells in between". In between

whatis where my confusion lies.I'll work on something.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

I'm making some assumptions with this code since I can't see your worksheet from where I'm sitting. 1 - Row 1 contains Column Headings that do not need to be moved. In other words your actual data starts in Row 2, therefore a new Row 3 will be the first row inserted.

2 - Column A contains data down to the last row that you need rearranged. Column A is used to determine how many rows (loops) the code has to go through, so we need data in Column A of the last row of your data when the code first runs.

3 - All rows have data at least out to Column L, meaning at least 1 cell needs to be moved in every row. In other words, at a minimum, every row needs something moved into Column G of the row below it.If any of these assumptions are incorrect, the code will need to be modified.

One additional note: As written, the code

copiesthe data from Columns L and beyond so that you can see if everything is working. Simply change the word.Copyto.Cutonce you are satified that the code is working.I strongly suggest you try this code in a backup copy of your workbook since macros cannot be easily undone.

Sub NarrowData() 'Determine how many rows we need to loop through 'Assume Column headers in Row 1 loopRws = Range("A" & Rows.Count).End(xlUp).Row - 1 'Loop through source Rows For srcRw = 3 To Rows.Count 'Determine how many Rows to Insert based on how much data is in current Row lastCol = Cells(srcRw - 1, Columns.Count).End(xlToLeft).Column dstRws = Application.WorksheetFunction.RoundUp((lastCol - 12) / 5, 0) - 1 'If No Data Beyond Column L, insert just 1 Row If dstRws = -1 Then dstRws = 0 'Insert Rows based on width of data in current Row Rows(srcRw & ":" & srcRw + dstRws).Insert 'Initialize variable for first Paste row dstRw = srcRw 'Cut(Copy) data to Column G For srcCol = 12 To lastCol Step 5 Range(Cells(srcRw - 1, srcCol), Cells(srcRw - 1, srcCol + 4)).Copy _ Destination:=Cells(dstRw, 7) dstRw = dstRw + 1 Next 'Set new Source Row srcRw = srcRw + dstRws + 1 'Count loops, exit when last Row has been done loopCnt = loopCnt + 1 If loopCnt = loopRws Then Exit For Next End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

YOU ARE AMAZING! It worked so well!

Thank you so so so much!!!

The only thing is, it only cut&paste 3 rows of information. There are about 2000 rows in the sheet. Where should I change in the Macro?

Again. Thank you SO much! It helps greatly!

Well, let's start with this: It worked so wellIf you have 2000 rows and it only copied 3, that's not exactly what I would call "working well". I would say that it's not working well at all.

I need to know a few things about your spreadsheet:

1 - Do all the rows have data out to Column BD? If not, what is the "shortest" row; in other words, what is the lowest column that a row goes out to?

2 - Do you have data in Column A all the the way down to the last row of data in your worksheet? If not, is there a column that has data all the way down to the last row of data? The code needs a way to count how many rows of data are in the spreadsheet so that it knows how many times to loop.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Oh I thought it will just be a quick change of code or something.

I will explain the sheet a bit more. Column A is the name of the facility. B-F is the info of the facility. G-K is the info of one person. L-P is the info of the 2nd person. And it goes on and on and on. The longest row goes up to Column BD.1 - Not all rows have data out to Column BD. The shortest row goes to Column K so it only has one person listed.

2 - Yes the data in Column A is the primary data and it continues all the way down to the last row.

I hope that clears up a bit?

If Column A goes all the way down to the last row, I don't quite understand why the code only copied 3 rows. Do me a favor. Run this code against the sheet. It won't change anything...I'm just curious as to what number it returns.

Sub NumRows() MsgBox Range("A" & Rows.Count).End(xlUp).Row End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

It returns 1194. And I will also post a screenshot after running the macro

I'm not sure what you are trying to show me. Since the data is supposed to be pasted in Columns G:K, showing me blank cells in Columns A:F doesn't provide any insight into what is happening. What I need to know is, for example, how many columns of data were in Row 2? Based on how the code should work, if 3 lines were inserted I would guess (and I hate to solve problems by guessing) that you had data in Row 2 out to at least Column V but not past Column Z. Can you verify that?

In general, what the code should be doing is going out to the last cell with data in each row, determining how many columns there are past Column K and inserting enough rows so that the existing data can be moved - in groups of 5 - to Columns G:K as requested.

For example, data in Row 2 out to Column V would be 11 columns that need to be moved. 11 columns means 2 groups of 5 plus 1 extra, so we need 3 rows to copy the data in Columns L2:V2 to G3:K3, G4:K4 and the "extra" piece from V2 to K5.

Data out to Column BD would require 9 new rows since there are 45 columns beyond K, 45/5 = 9.

That's how the code is

supposedwork, but I'm not saying that is working correctly yet. Since I don't have your spreadsheet to work with, it's a little tough to provide the perfect solution unless I know some specifics about your sheet.In addition, it appears that you have drop downs in Row 1. How will inserting rows impact your use of the drop downs?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Yes Row 2 has data up to Column Z. And I don't use the drop downs so it doesn't matter what the impact will be (or if there is even an impact).

I can't think of a way to explain it clearer...will it help if I give you the original sheet? It has been modified to reveal no personal information and also a lot shorter (goes only to Row 30), if that doesn't take too much of your time...I mean I feel like I have already taken a lot of your time and I am grateful for your help. I totally understand if you feel this is too much now...

I've sent you an email address via Private Message. Please do not share the email address with anyone. It is temporary and will be deleted when this issue is resolved.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Final Solution, verified by requester via email: Sub NarrowData() Application.ScreenUpdating = False 'Determine how many rows we need to loop through 'Assume Column headers in Row 1 loopRws = Range("A" & Rows.Count).End(xlUp).Row - 1 'Loop through source Rows For srcRw = 3 To Rows.Count 'Determine how many Rows to Insert based on how much data is in current Row lastCol = Cells(srcRw - 1, Columns.Count).End(xlToLeft).Column dstRws = Application.WorksheetFunction.RoundDown((lastCol - 12) / 5, 0) 'If no data past Column K, no Insert needed If dstRws < 1 Then loopCnt = loopCnt + 1 GoTo NoInsert End If 'Insert Rows based on width of data in current Row Rows(srcRw & ":" & srcRw + dstRws).Insert 'Initialize variable for first Paste row dstRw = srcRw 'Cut(Copy) data to Column G For srcCol = 12 To lastCol Step 5 Range(Cells(srcRw - 1, srcCol), Cells(srcRw - 1, srcCol + 4)).Copy _ Destination:=Cells(dstRw, 7) dstRw = dstRw + 1 Next 'Set new Source Row srcRw = srcRw + dstRws + 1 'Count loops, exit when last Row has been done loopCnt = loopCnt + 1 If loopCnt = loopRws Then Exit For NoInsert: Next End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Ask Your Question

Weekly Poll

Do you think Monopoly should update its pieces?

Discuss in The Lounge

Poll History