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

bigdan

Well-known Member
Joined
Oct 5, 2009
Messages
846
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?




VBA 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(xlUp).Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    ' Range("P2").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 by a moderator:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
edit - please ignore. I tried to edit this and couldnt. I made a new thread. btw how do I find all my posts? I had a hell of a time finding them.
 
Upvote 0
Edit again - this thread is back to being active. So if someone could please advise I'd be grateful.
 
Upvote 0
You're description & your code seem at odds with each other, can you post some sample data.

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

To find your threads click on your avatar at the top right of the board & select "Your Content"
 
Upvote 0
You're description & your code seem at odds with each other, can you post some sample data.

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

To find your threads click on your avatar at the top right of the board & select "Your Content"

Here's a picture. We're taking the data from Col J:K and pasting that into A:B. Then putting a dot at the end of that in col A. Then moving on to R:S and pasting that into A:B below the dot we made a moment ago. And so on.
 

Attachments

  • Excel Macro Screenshot.PNG
    Excel Macro Screenshot.PNG
    60 KB · Views: 21
Upvote 0
Any reason you are skipping N:O? And are there any columns that need to be skipped?
 
Upvote 0
Looking at your data & code, it looks as though the 1st columns to be copied is N:O, not J:K. If that's the case try
VBA Code:
Sub bigdan()
   Dim Ar As Areas
   Dim i As Long
   
   Set Ar = Range("A1:BZ1").SpecialCells(xlConstants).Areas
   For i = 3 To Ar.Count
      Ar(i).Offset(1).Value = "Data set " & i - 2
      With Range(Ar(i).Offset(1), Cells(Rows.Count, Ar(i).Column).End(xlUp)).Resize(, 2)
         If i = 3 Then
            .Copy Range("A2")
         Else
            .Copy Range("A" & Rows.Count).End(xlUp).Offset(1)
         End If
      End With
      Range("A" & Rows.Count).End(xlUp).Offset(1).Value = "."
   Next i
End Sub
 
Upvote 0
Looking at your data & code, it looks as though the 1st columns to be copied is N:O, not J:K. If that's the case try
VBA Code:
Sub bigdan()
   Dim Ar As Areas
   Dim i As Long
  
   Set Ar = Range("A1:BZ1").SpecialCells(xlConstants).Areas
   For i = 3 To Ar.Count
      Ar(i).Offset(1).Value = "Data set " & i - 2
      With Range(Ar(i).Offset(1), Cells(Rows.Count, Ar(i).Column).End(xlUp)).Resize(, 2)
         If i = 3 Then
            .Copy Range("A2")
         Else
            .Copy Range("A" & Rows.Count).End(xlUp).Offset(1)
         End If
      End With
      Range("A" & Rows.Count).End(xlUp).Offset(1).Value = "."
   Next i
End Sub

Actually N:O would be the first set, J:K is more of a summary not a source so can be ignored. I assume this code will still work but I should modify it slightly?
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

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