how do i take this long code and turn it into a loop?

Status
Not open for further replies.

bigdan

Well-known Member
Joined
Oct 5, 2009
Messages
843
Office Version
  1. 2013
Platform
  1. Windows
Hi guys. I don't really know VBA except for a little bit here and there so I'm hoping to get some advice here. This is mainly me recording a macro and then editing the code to get it to do what I want. This essentially gets the job done but I know it could be made much cleaner with loops. Which I don't know how to do right now.

Here's what this code actually does. There is data that starts in approximately column F and will always come 2 columns at a time but the number of rows is not consistent, it could be as little as two or as many as 20. So the first set of data would be in approximately column F the second set might be four columns to the right of that, then the third set might be another few columns to the right. I want to take all this data which goes all the way up until column BZ, and move it all into columns A and B so I can do a simple VLOOKUP. I'll separate each data set with the period in between and column A.

What I'm doing right now is starting at cell A1, pressing Ctrl + right arrow four times to get me to the first data set, then pasting it and cell A2. Then going to the last cell in column A that has data, going to the next row, and putting a period there. That concludes the first set of data moved into column A. Now I need to go to the next set of data so I'll go to the cell A1. To get to the first data set I pressed control plus right button for times. This time I'll do that five times. Then same drill I'll move it to column A. Then I'll go back to column A1 and press the Ctrl and right button six times. And so on and so on. That's what you're seeing in the data below.

How would I clean up this code so I can simply loop it rather than writing essentially the same instructions 10 times?


This is what one iteration of the code would look like.
Range("A1").Select
'This is navigating to the relevant data
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select


' This is copying the data without headers. Writing "1st Data Set" just for testing / debugging, will remove later
ActiveCell.Offset(1).Select
ActiveCell.Value = "1st Data Set"

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
Application.CutCopyMode = False
'Putting a dot at the end simply to show the end of the data set. Will add more datasets after the dot in subsequent loops.
ActiveCell.FormulaR1C1 = "."



Here's the full code
Sub TestingRearrange2()
'
' TestingRearrange2 Macro
'

' Going to first set of data

Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
' Range("M2").Select

' This should move selection one cell down
ActiveCell.Offset(1).Select
ActiveCell.Value = "1st Data Set"

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A2").Select
ActiveSheet.Paste
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
'Range("A17").Select

' This should move selection one cell down
ActiveCell.Offset(1).Select

Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "."

Range("A1").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select

' This should move selection one cell down
ActiveCell.Offset(1).Select
ActiveCell.Value = "2nd Data Set"

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A1").Select
Selection.End(xlDown).Select
'Range("A18").Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
' Range("A35").Select (idk what this is)
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "."
Range("A1").Select
Selection.End(xlUp).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select

'Range("S2").Select
ActiveCell.Offset(1).Select
ActiveCell.Value = "3rd Data Set"

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A1").Select
Selection.End(xlDown).Select
'Range("A36").Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
' Range("A51").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "."
Range("A1").Select
Selection.End(xlUp).Select

Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select

'Range("V2").Select
ActiveCell.Offset(1).Select
ActiveCell.Value = "4th Data Set"

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "."
Range("A1").Select
Selection.End(xlUp).Select

Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select

ActiveCell.Offset(1).Select
ActiveCell.Value = "5th Data Set"

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "."
Range("A1").Select
Selection.End(xlUp).Select

'Remember to add a row
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select

ActiveCell.Offset(1).Select
'Remember to increment
ActiveCell.Value = "6th Data Set"

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "."
Range("A1").Select
Selection.End(xlUp).Select
End Sub
 
Last edited:

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Status
Not open for further replies.

Forum statistics

Threads
1,215,061
Messages
6,122,921
Members
449,094
Latest member
teemeren

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top