Need Macro Help

[rhatala]

Thank you for your help...
Running Excel 2003 SP2

Have a worksheet of companies with multiple contacts in separate
columns. Will use this spreadsheet to import to a CRM package via
..csv format.

In order to import multiple contacts for a company, the company value
has to match exactly on multiple records to add the multiple contacts.
Company records (if exact match) do not get added.

The need:

Example: (Current)
Company Exec Title IS Exec IS-Title
ABC Bob CFO John CIO
XYX Joe CFO

Desired result:
Company Exec Title IS Exec IS-Title
ABC Bob CFO
ABC John CIO
XYZ Joe CFO

For company records where there contacts in both Exec and IS Exec
colums, I want to copy the complete row, insert the new record in the
next row below, move the IS Exec and IS-Title cells into the Exec and
Title cells, then remove the IS Exec and IS-Title cell values in the
previous record.

I can get this macro to work via record, however when I position the
starting point for another record to run the macro on, it simply
duplicates the original record.

What am I doing wrong? How can I get the macro to work on any record
I want to macro to work on?

Thanks
Bob

 

[Bob Phillips]

Sub Test()
Dim iLastRow As Long
Dim i As Long

Application.ScreenUpdating = False
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
If Cells(i, "D").Value <> "" Then
Rows(i + 1).Insert
Cells(i + 1, "A").Value = Cells(i, "A").Value
Cells(i + 1, "B").Value = Cells(i, "D").Value
Cells(i + 1, "C").Value = Cells(i, "E").Value
End If
Next i
Columns("D:E").Delete
Application.ScreenUpdating = True

End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)