Need Macro to Repeat Until Finished (at Blank cells)

ACP454

New Member
Joined
Oct 18, 2018
Messages
2
Hello and thanks in advance for your help,

I have a database of roughly 5,000 companies with 20,000 lines of data, with the company data stacked vertically vs horizontally. Each company is shown as follows...

  • Company name
  • Street address
  • City, St Zip
  • County

I need each company's data to appear on one row and I have successfully created the following macro to move the cell contents, after I insert three empty columns, to the right of the original data cells, as follows....
__________________________________________
Sub NameMove()
'
' NameMove Macro
'
' Keyboard Shortcut: Ctrl+n
'
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1")
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1")
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Cut Destination:=ActiveCell.Offset(-3, 3).Range("A1")
ActiveCell.Offset(1, 0).Range("A1").Select

End Sub
_________________________________________

My question is, what is the code to have this process repeat until there are no more cells with data?

THANK YOU for your help!

ACP454


 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Hi & welcome to MrExcel.
How about
Code:
Sub test1()
   Dim i As Long
   For i = 1 To 20 Step 4
      Cells(i, 2).Resize(, 3).Value = Application.Transpose(Cells(i + 1, 1).Resize(3))
   Next i
  [COLOR=#0000ff] Range("B:B").SpecialCells(xlBlanks).EntireRow.Delete[/COLOR]
End Sub
If you don't want to delete the blank rows remove the line in blue
 
Upvote 0

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

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