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

B

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:
Sort by date Sort by votes
****! That worked beautifully! With my code it tends to slow down at some point but yours just zipped through the whole thing. Thanks!

I have some questions if you don't mind.

1. I don't actually need for it to say "Data Set 1" "Data Set 2" etc. That was just to trace where the macro is at any given point. So to remove that do I just simply remove this one line?
Ar(i).Offset(1).Value = "Data set " & i - 2
Click to expand...


2. What's happening in this line?
Set Ar = Range("A1:BZ1").SpecialCells(xlConstants).Areas
Click to expand...

So the variance Ar is of the type Areas. I guess that means range?
This looks at the range given there. Not sure what SpecialCells does.

3.
Ar(i).Offset(1).Value
Click to expand...

Let's say i = 3. I understand what offset means, I believe that's just bringing it down one row. But what does Ar(3) mean?


I've got other questions but perhaps it would make sense for me to just figure out the above first :)
 
Upvote 0

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
VBA Code: 
Sub test()
Dim myCol As New Collection
Dim Rng1, Rng2, Rng3, Rng4 As Range
Set Rng1 = Range("N2:O" & Range("O65000").End(xlUp).Row)
Set Rng2 = Range("R2:S" & Range("S65000").End(xlUp).Row)
Set Rng3 = Range("V2:W" & Range("W65000").End(xlUp).Row)
Set Rng4 = Range("Z2:AA" & Range("AA65000").End(xlUp).Row)
For Each Item In Rng1
myCol.Add Item
Next
myCol.Add "."
myCol.Add "."
    For Each Item In Rng2
    myCol.Add Item
    Next
    myCol.Add "."
    myCol.Add "."
        For Each Item In Rng3
        myCol.Add Item
        Next
        myCol.Add "."
        myCol.Add "."
            For Each Item In Rng4
            myCol.Add Item
            Next
            
[q1].Value = myCol.Count
For i = 1 To myCol.Count / 2
   Cells(i + 1, "A").Value = myCol(i * 2 - 1)
   Cells(i + 1, "B").Value = myCol(i * 2)
Next

End Sub
 

Attachments

  • Capture.JPG
    Capture.JPG
    125.6 KB · Views: 13
Upvote 0
1) Yes, that's right.
2) That line looks at all the cells in A:BZ1 that contain a value (other that formulae) & each Area is a contiguous range of those cells.
3) the Ar(i) is each contiguous range of cells that have a value, so Ar(3) is the 3rd block of contiguous cells.

HTH
 
Upvote 0
bebo021999 said:
VBA Code: 
Sub test()
Dim myCol As New Collection
Dim Rng1, Rng2, Rng3, Rng4 As Range
Set Rng1 = Range("N2:O" & Range("O65000").End(xlUp).Row)
Set Rng2 = Range("R2:S" & Range("S65000").End(xlUp).Row)
Set Rng3 = Range("V2:W" & Range("W65000").End(xlUp).Row)
Set Rng4 = Range("Z2:AA" & Range("AA65000").End(xlUp).Row)
For Each Item In Rng1
myCol.Add Item
Next
myCol.Add "."
myCol.Add "."
    For Each Item In Rng2
    myCol.Add Item
    Next
    myCol.Add "."
    myCol.Add "."
        For Each Item In Rng3
        myCol.Add Item
        Next
        myCol.Add "."
        myCol.Add "."
            For Each Item In Rng4
            myCol.Add Item
            Next
           
[q1].Value = myCol.Count
For i = 1 To myCol.Count / 2
   Cells(i + 1, "A").Value = myCol(i * 2 - 1)
   Cells(i + 1, "B").Value = myCol(i * 2)
Next

End Sub
Click to expand...
Thanks!

This worked with the first dataset. With the second one, in Cell Q1 it replaced the words "Transaction Amount" with "214". A lot of the pasting to col A seems a bit off. And it didnt do anything beyond Col Z. So this seems a bit off. That's fine no need to fix the code if it's much trouble as some other code has already been written. But if you'd like to try I can read it to try to learn something :)
 
Upvote 0
bigdan said:
Thanks!

This worked with the first dataset. With the second one, in Cell Q1 it replaced the words "Transaction Amount" with "214". A lot of the pasting to col A seems a bit off. And it didnt do anything beyond Col Z. So this seems a bit off. That's fine no need to fix the code if it's much trouble as some other code has already been written. But if you'd like to try I can read it to try to learn something :)
Click to expand...
Can you post image of before and after coding?
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
macro for copying values to the next blank cell
Replies
5
Views
463
Micron
M
D
  • Solved
Trying to copy data from a specific sheet in one workbook to another with VBA
Replies
2
Views
177
druck21
D
D
  • Solved
VBA If statement to continue
2
Replies
17
Views
653
dinunan
D
C
  • Question Question
How to automatically paste the data from one sheet to another using VBA
Replies
4
Views
292
Alex Blakenburg
A
J
  • Question Question
VBA or formula to move data in last used column to column A
Replies
5
Views
229
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,224,828
Messages
6,181,201
Members
453,022
Latest member
RobertV1609

Share this page

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