Make recorded macro loop

Originally Posted by arlu1201

It will be good if you explain what your code is trying to do. Sometimes while recording the macro, if you click on the wrong cell(s), it still includes it and this will not help us in editing the code for you.

Well it's a little hard to say but I'm converting columns to rows. Example column E has a header row and then below that are several fees. I'm moving the fees into column b and then in column C I'm copying the header row for all the fees for that column and the next columns goes right beneth the prior column in the rows. The current macro is working great but I just don't know how to get it to keeping going to the next column until they have all been converted to rows.

Originally Posted by cowannbell

Well it's a little hard to say but I'm converting columns to rows. Example column E has a header row and then below that are several fees. I'm moving the fees into column b and then in column C I'm copying the header row for all the fees for that column and the next columns goes right beneth the prior column in the rows. The current macro is working great but I just don't know how to get it to keeping going to the next column until they have all been converted to rows.

Sub ARS2013test()
'
' ARS2013test Macro
'
' Keyboard Shortcut: Ctrl+t
'
    ActiveCell.Offset(0, 1).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    ActiveCell.Offset(0, -3).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    Selection.End(xlUp).Select
    ActiveCell.Offset(-1, 0).Range("A1").Select
    Selection.End(xlToRight).Select
    Selection.Copy
    ActiveCell.Offset(1, -2).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1:A31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.End(xlUp).Select
    ActiveCell.Offset(0, 2).Columns("A:A").EntireColumn.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    ActiveCell.Offset(1, -1).Range("A1").Select
End Sub

See sample below.

Try this one

Sub Macroloop()
 Dim a, b, i As Long, j As Long, k As Long, n As Long, m As Long
 
 a = Sheets("Before").Range("a2").CurrentRegion
 n = 1
 ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To UBound(a, 2))
 
 b(1, 1) = "SERVC_CD"

 For i = 2 To UBound(a, 2)
      
    For j = 1 To UBound(a, 1) - 1
        n = n + 1
        b(n, 3) = a(1, i)
    Next
 Next
m = 1
    For k = 2 To UBound(a, 1)
         m = m + 1
         b(m, 1) = a(k, 1)
         b(m, 2) = a(k, 2)
    Next
    
        For i = 2 To UBound(a, 1)
             m = m + 1
            b(m, 2) = a(i, 3)
             
        Next
 
 Sheets("After").Range("A1").Resize(n, UBound(a, 2)) = b
 Sheets("After").Range("A1").Resize(m, UBound(a, 2)) = b
End Sub

it errors on this line

a = Sheets("Before").Range("a2").CurrentRegion

error is script out of range

Not according to the attached. You should have a workbook called "Before", or tell me the name of your worksheet and will change it.

Okay, I used the sheet that I had sent you and it works but just for the first two schs/columns. The example I sent you only had two schs/columns but the work book that I work with can have many that need to be converted. This macro did fees for the two columns over but not for any of the other columsn on the sheet. So on the after sheet i column b only two schs listed in column c has fees listed in column b. It did not pull the fees for all the other columns.

You need to post your new sample book, and I will adjust the code accordingly. I can't adjust my code with out seeing your new request. The code worked on the sample provided.

There is no difference in the one I sent you and the one I'm working other than there are more columns that need to be converted. Your code works for column C but doesn't work for column B in the after sheet except for the first two columns in the before sheet.

Please see new sheet 2 and you will see what the macro did. It did column c in the after sheet correctly but not column B.

Thanks.

You have 3 columns in your before sheet, so I do not know which columns you are reffering to. Could you please explain whcih columns need to be converted and where? What is missing from my code?

Let's look at column b which has a header of DP4KA below that are the fees that go with that code. If you look in the after sheet you will not see the fees in Column B except for DP4KA and DP4KB where there should be fees showing for all of the columns starting with Column B in the Before Sheet. Your macro did take the column headings and put them all in column C in the after sheet which is correct it just doesn't pull the fees over that go with that column.

Please see attacched. You need to show me what is missing, I do not know which are your fees, I can only go by the data type. You need to show me where each row and column should go.

Please look at the 2nd file that I attached. The before sheet has many more columns. The amount of columns after columns a and b can change at any time. There could be 10 or 30 or so on. If you run the macro that you sent me on the 2nd file that I attached, you will see what is missing or if you just look at the one I sent you on the after sheet you will see what is missing starting on row 64 column B.

Cow,
Sorry! I did not see your attachment. I do not know how I missed it and subsequently asked you to attach again. Here is the amended code. It is not good for the eye to see, but it does the job. If I had the time, I would have written a short code.

Sub Macroloop()
 Dim a, b, i As Long, j As Long, k As Long, n As Long, m As Long
 
 a = Sheets("Before").Range("a2").CurrentRegion
 n = 1
 ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To UBound(a, 1))
 
 b(1, 1) = "SERVC_CD"

 For i = 2 To UBound(a, 2)
      
    For j = 1 To UBound(a, 1)
        n = n + 1
        b(n, 3) = a(1, i)
        
    Next
 Next
m = 1
    For i = 2 To UBound(a, 2)
    
        For j = 2 To UBound(a, 1)
          m = m + 1
          b(m, 2) = a(j, i)
        Next
 Next
 k = 1
         For i = 2 To UBound(a, 1)
             k = k + 1
             b(k, 1) = a(i, 1)
             
        Next
  
 Sheets("After").Cells.ClearContents
 Sheets("After").Range("A1").Resize(n, UBound(a, 2)) = b
 Sheets("After").Range("A1").Resize(m, UBound(a, 2)) = b
 Sheets("After").Range("A1").Resize(k, UBound(a, 2)) = b
 
End Sub

Please see attached after the first two conversions from the before page, you will see that in the after page, the fee which are in column b in the after sheet are not in order and if you go to the end of the page you will see that not even all of the fees in column b are pulled over.

I does on my sample. Please see attached

No it doesn't. Look at the after tab and line 33. You will see DP6NA and it should be DP6NB with 4 in column b.

That did it, thanks so much.

You are welcome!
Could you please now close this post as solved by going in to the top right hand of this page-Choose solved from the "Thread Tools" drop down menu?