Programming help
Hello,
This is my first post.
Attached are two spreadsheets. One contains a list of records i.e. name, company name, title, address etc. The second shows how i would like to see these records (in a row format as opposed to a column format). Is there a way to program this? I have about 450-500 records in a column format.
Can anybody help me?
Thank you,
Kevin
| Attachment | Size |
|---|---|
| requested layout.xlsx | 10.34 KB |
| list of records.xlsx | 13.99 KB |
Macro to solve your problem!
Hello I did the perfect macro for you.
You just need to insert a blank cell for the contacts that do not have email in order to use the same number of cells for each contact.
Then, just run this macro and your request layout is ready!
Sub requestedlayout()
'change it to horizontal position
Range("A1").Select
Do Until ActiveCell.Row = 2000
If Selection.Font.Bold = True Then
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
Selection.Cut Destination:=ActiveCell.Offset(-4, 4).Range("A1")
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Cut Destination:=ActiveCell.Offset(-5, 5).Range("A1")
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Cut Destination:=ActiveCell.Offset(-6, 6).Range("A1")
ActiveCell.Offset(1, 0).Range("A1").Select
Else: ActiveCell.Offset(1, 0).Select
End If
Loop
'delete empty rows
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'insert title row
Range("a1").Select
ActiveCell.EntireRow.Insert
Range("A1").Value = "Name"
Range("b1").Value = "Title"
Range("c1").Value = "Company"
Range("d1").Value = "Address"
Range("e1").Value = "City,State and Zip"
Range("f1").Value = "Phone#"
Range("g1").Value = "Email"
Range("A1").EntireRow.Font.Bold = True
Range("A1").EntireRow.Font.Size = 11
Range("A1").EntireRow.Font.Name = "Calibri"
End Sub
It will save you a lot of time, I hope it helps.
Cátia Santos