Help with a macro

jhbendeck

New Member
Joined
Jun 26, 2021
Messages
5
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
  2. Web
Hello, good evening. Hope all of you are doing great.

In the following thread, I'd like you to help me out with a basic macro where I can move some cells from a default row to another row (the range starts in E2 and ends in AC2, and I need to move from E2 to H2 to A3, B3, C3 and D3), and probably do the same thing for other rows. Here is a picture of how it looks:

1624757051796.png


In this first picture, the content from F2 to H2 has to be moved to B3, C3 and D3. Then, the content from I2 to K2 has to be moved to B4, C4 and D4 and so on until it reaches 8 entries (as you can see, in the spreadsheet, I had to create 8 rows in order to move that content manually). The limit of the content is AC2.

And this is how it is supposed to look:

1624757085147.png


I have to execute this task for more than 100 entries, so I would truly appreciate your help with a better way than cutting and pasting this info (I've done this procedure for 2 hours to move more than 20 entries).

Any help would be really appreciated. Thanks in advance.
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,675
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Welcome to MrExcel Message Borad.
Try this Macro:
VBA Code:
Sub Transform()
Dim i As Long, j As Long, Lr As Long, Lc As Long
Lr = Range("A" & Rows.Count).End(xlUp).Row
Lc = Cells(1, Columns.Count).End(xlToLeft).Column

For i = 1 To Lr
If Range("A" & i).Value <> "" Then
For j = 5 To Lc Step 4
Range(Cells(i + (j - 1) / 4, 1), Cells(i + (j - 1) / 4, 4)).Value = Range(Cells(i, j), Cells(i, j + 3)).Value
Next j
i = i + (j - 5) / 4
End If
Next i
Range("E1:AC" & Lr).ClearContents
End Sub
 

jhbendeck

New Member
Joined
Jun 26, 2021
Messages
5
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
  2. Web
Hello, @maabadi . Thank you for taking your time helping me out. This is how it appeared:

1625188152422.png


I don't know if there is something to adjust in the variables. I appreciate your help. If you need the file, here it is, sir. Link for the file

Please let me know if you need anything else, in order to help me out. I'd truly appreciate it. You're a life savior. :)
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,675
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
I don't know if there is something to adjust in the variables.
What is problem? What else you want?
You want Autofit Column or .....
Please Describe it with Details.
 

jhbendeck

New Member
Joined
Jun 26, 2021
Messages
5
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
  2. Web

ADVERTISEMENT

Hello, sir.
I recorded this macro in Excel (This is a dummy's work):

VBA Code:
Sub MacroMove()
'
' MacroMove Macro
'
'
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B3").Select
    ActiveSheet.Paste
    Range("E3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B4").Select
    ActiveSheet.Paste
    Range("E4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B5").Select
    ActiveSheet.Paste
    Range("E5").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B6").Select
    ActiveSheet.Paste
    Range("E6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B7").Select
    ActiveSheet.Paste
    Range("E7").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B8").Select
    ActiveSheet.Paste
    Range("E8").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Cut
    Range("B9").Select
    ActiveSheet.Paste
    Range("E9").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B10").Select
    ActiveSheet.Paste
    Range("F11").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B12").Select
    ActiveSheet.Paste
    Range("E12").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B13").Select
    ActiveSheet.Paste
    Range("E13").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B14").Select
    ActiveSheet.Paste
    Range("E14").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B15").Select
    ActiveSheet.Paste
    Range("E15").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B16").Select
    ActiveSheet.Paste
    Range("E16").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B17").Select
    ActiveSheet.Paste
    Range("E17").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B18").Select
    ActiveSheet.Paste
    Range("E18").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B19").Select
    ActiveSheet.Paste
    Range("F20").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B21").Select
    ActiveSheet.Paste
    Range("E21").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B22").Select
    ActiveSheet.Paste
    Range("E22").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B23").Select
    ActiveSheet.Paste
    Range("E23").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B24").Select
    ActiveSheet.Paste
    Range("E24").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B25").Select
    ActiveSheet.Paste
    Range("E25").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B26").Select
    ActiveSheet.Paste
    Range("E26").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B27").Select
    ActiveSheet.Paste
    Range("E27").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut
    Range("B28").Select
    ActiveSheet.Paste
End Sub

I did this manually, and it look like this:

1625197996536.png


This procedure has to be done N times in the same spreadsheet, so that the information at the end, can look like this at the end (after the info is organized, I move the numbers to the column E and I copy the content from cells A2, A11, A20, A29, and every 9 rows with the same info contained in those cells):

1625198232475.png


I dunno if with this, I made myself clear. Thanks for your help and taking the time to help me.
 

Attachments

  • 1625197751336.png
    1625197751336.png
    160.2 KB · Views: 2
Last edited by a moderator:

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,801
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Hello, sir.
I recorded this macro in Excel (This is a dummy's work):

Sub MacroMove()
'
' MacroMove Macro
'
'
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B3").Select
ActiveSheet.Paste
Range("E3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B4").Select
ActiveSheet.Paste
Range("E4").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B5").Select
ActiveSheet.Paste
Range("E5").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B6").Select
ActiveSheet.Paste
Range("E6").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B7").Select
ActiveSheet.Paste
Range("E7").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B8").Select
ActiveSheet.Paste
Range("E8").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Cut
Range("B9").Select
ActiveSheet.Paste
Range("E9").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B10").Select
ActiveSheet.Paste
Range("F11").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B12").Select
ActiveSheet.Paste
Range("E12").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B13").Select
ActiveSheet.Paste
Range("E13").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B14").Select
ActiveSheet.Paste
Range("E14").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B15").Select
ActiveSheet.Paste
Range("E15").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B16").Select
ActiveSheet.Paste
Range("E16").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B17").Select
ActiveSheet.Paste
Range("E17").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B18").Select
ActiveSheet.Paste
Range("E18").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B19").Select
ActiveSheet.Paste
Range("F20").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B21").Select
ActiveSheet.Paste
Range("E21").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B22").Select
ActiveSheet.Paste
Range("E22").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B23").Select
ActiveSheet.Paste
Range("E23").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B24").Select
ActiveSheet.Paste
Range("E24").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B25").Select
ActiveSheet.Paste
Range("E25").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B26").Select
ActiveSheet.Paste
Range("E26").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B27").Select
ActiveSheet.Paste
Range("E27").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B28").Select
ActiveSheet.Paste
End Sub

I did this manually, and it look like this:
Did that code do what you wanted it to do?
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,675
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

Try this:
VBA Code:
Sub Transform()
Dim i As Long, j As Long, Lr As Long, Lc As Long, S As Long, E As Long, K As Long, P As Boolean
Lr = Range("A" & Rows.Count).End(xlUp).Row
Lc = Cells(1, Columns.Count).End(xlToLeft).Column
On Error GoTo ErrHandler
For i = 2 To Lr
If Range("A" & i).Value <> "" Then
K = i
S = 6
For j = 5 To Lc
If Left(Cells(i, j).Value, 4) = "http" Then
E = j + 1
K = K + 1
Range(Cells(K, 2), Cells(K, 4)).Value = Range(Cells(i, S), Cells(i, E)).Value
Cells(K, 5).Value = Cells(K - 1, 5).Value
End If
If IsNumeric(Cells(i, j).Value * 1) Then S = j + 1
TypeMismatch:
Next j

End If
ErrHandler:
If Err = 13 Then Resume TypeMismatch
Next i
Range("F1:AC" & Lr).ClearContents
End Sub
 

jhbendeck

New Member
Joined
Jun 26, 2021
Messages
5
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
  2. Web
Did that code do what you wanted it to do?
Hello, sir. Good morning. Nice to meet you.

Well, the code I pasted in this thread was a manual macro I recorded, but the pattern you see there is the one I am trying to simplify in one single code for many entries of the spreadsheet (as you can see, I am attempting to move a set of three cells from one row to a new row, and those set ranges are between F and H, I and K, L and N, until AC).

If there's any additional information you require to assist me, I'd truly appreciate it.

Thanks in advance.
 

jhbendeck

New Member
Joined
Jun 26, 2021
Messages
5
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
  2. Web
Try this:
VBA Code:
Sub Transform()
Dim i As Long, j As Long, Lr As Long, Lc As Long, S As Long, E As Long, K As Long, P As Boolean
Lr = Range("A" & Rows.Count).End(xlUp).Row
Lc = Cells(1, Columns.Count).End(xlToLeft).Column
On Error GoTo ErrHandler
For i = 2 To Lr
If Range("A" & i).Value <> "" Then
K = i
S = 6
For j = 5 To Lc
If Left(Cells(i, j).Value, 4) = "http" Then
E = j + 1
K = K + 1
Range(Cells(K, 2), Cells(K, 4)).Value = Range(Cells(i, S), Cells(i, E)).Value
Cells(K, 5).Value = Cells(K - 1, 5).Value
End If
If IsNumeric(Cells(i, j).Value * 1) Then S = j + 1
TypeMismatch:
Next j

End If
ErrHandler:
If Err = 13 Then Resume TypeMismatch
Next i
Range("F1:AC" & Lr).ClearContents
End Sub
Hello, sir. Good morning.

I think that should do it and you're the man! After executing the macro, this was the result (which might help me to do this faster and more organized):

1625231577564.png

All I need to do is to clean the value in Peso Inicial, move the values from D3:D10 to E3:E10 and copy the cell in A2 in the range from A3-A10. But that has been really useful.

Thank you so much!
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,675
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
This is different than file of uploaded format. I write macro based on.
Try this:
VBA Code:
Sub Transform() 
Dim i As Long, j As Long, Lr As Long, Lc As Long, S As Long, E As Long, K As Long, P As Boolean 
Lr = Range("A" & Rows.Count).End(xlUp).Row 
Lc = Cells(1, Columns.Count).End(xlToLeft).Column 
On Error GoTo ErrHandler 
For i = 2 To Lr 
If Range("A" & i).Value <> "" Then 
K = i 
S = 6 
For j = 5 To Lc 
If Left(Cells(i, j).Value, 4) = "http" Then 
E = j + 1 
K = K + 1 
Range(Cells(K, 2), Cells(K, 3)).Value = Range(Cells(i, S), Cells(i, E -1)).Value
Cells(K, 5).Value = Cells(i, E).Value 
Cells(K, 4).Value = Cells(K-1, 4).Value
End If 
If IsNumeric(Cells(i, j).Value * 1) Then S = j + 1 
TypeMismatch: 
Next j 
End If 
ErrHandler: 
If Err = 13 Then Resume TypeMismatch
 Next i 
Range("F1:AC" & Lr).ClearContents 
End Sub
 
Solution

Forum statistics

Threads
1,147,476
Messages
5,741,349
Members
423,656
Latest member
Medrok2021

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
Top