Forum Home
Press F1
 
Thread ID: 54338 2005-02-09 22:19:00 Excel Macros Spartacus (3313) Press F1
Post ID Timestamp Content User
323082 2005-02-09 22:19:00 I have a list of contacts exported into excel, really badly formatted but fortunately consistent. The data for each contact is currently spread over 7 rows and a few columns, but I want one row for each contact with the data for each in columns (as standard as it comes!)

I've recorded a macro that will format the currently selected contact, delete the extra 6 rows, and select the next contact - works a charm, BUT...

1. How do I get the macro to repeat itself through all the contacts to save me having to hold down the shortcut key for 30 seconds while it does its work?

2. The contact list is periodically updated in an external program and re-exported as a messy excel file - what's the EASIEST way of getting the macro to do its stuff in the new workbook?? (pref without having to go into the VB editor and project explorer and dragging to the new book and running...)

Suggestions much appreciated,

Darren 		Spartacus (3313)
323083 2005-02-09 22:57:00 Q1. Post your code and Ill amend it 4 u.

Q2. Save the code in your personal macro workbook. The code would need to be non-workbook/sheet specific so it will work on any workbook. 		Parry (5696)
323084 2005-02-10 03:10:00 Hi, just in case I dont get online tonight then heres an example where data is all in column A and Im copying the 6 cells underneath over to column B:G then deleting the 6 rows and moving onto the next one. So this is effectly putting the data as horizontal rather than vertical.

This will have to be amended to suit your copying process but gives you an idea of how to loop through a process.


Sub Example()
Dim i As Long

With ActiveSheet
Do
'increment a counter to represent the row you are on
i = i + 1
'copy data from the cell underneath to 6 cells underneath current row
.Range(.Cells(i + 1, 1), .Cells(i + 6, 1)).Copy
'paste the copied cells into column B:G of current row
.Cells(i, 2).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
'delete rows from the row underneath to 6 cells underneath current row
.Range(.Cells(i + 1, 1), .Cells(i + 6, 1)).Delete
'loop to the next row if the next cell below isnt empty
Loop While Not IsEmpty(.Cells(i + 1, 1).Value)
End With

'Turn off copy mode
Application.CutCopyMode = False

End Sub 		Parry (5696)
323085 2005-02-11 18:34:00 Since you havent replied I guess youve worked this out yourself? Parry (5696)
1