How to shift the cell based on the location of other cell?

[Paul]

I have a workbook with the contact information showing in several rows, for
example in the first Column and first Row (A1) it shows the "Name" then on
the second column it shows the "Address" on the B2 and "Phone Number" on C3
and so on. As a result for every contact information it occuplies several
rows. How to write an vba code to clean up the information so that for each
of the conatct information the information showing on each of the column is
the same row number as the "Name" column and perhaps remove all the blank
rows at the end of the process? Thanks.

Example:

Name Address Phone Fax
John Doe
123 Street
123-456-789
456-444-7845

Jane Doe
369-456-7899
456 Street
236-456-4578

 

[Tom Ogilvy]

If none of the entries are missing an element of the address

Sub ClearBlanks()
Columns("A").Specialcells(xlBlanks).Delete
End Sub

 

[Paul]

Thanks Tom:

Yes some contact may not have the "Address" and/or "Phone" and/or "Fax" as a
result I don't think to delete all the "Blank" cells will work.

 

[Tom Ogilvy]

Sub adjustData()
Dim rng As Range, i As Long
Dim cell As Range
Set rng = Range("A2", Cells(Rows.Count, 4) _
.End(xlUp)).SpecialCells(xlConstants)
For Each cell In rng
If cell.Column = 1 Then
If cell.Offset(1, 1) = "" Then
cell.Offset(0, 1).Formula = "=NA()"
If cell.Offset(1, 2) = "" Then
cell.Offset(0, 2).Formula = "=NA()"
If cell.Offset(1, 3) = "" Then
cell.Offset(0, 3).Formula = "=NA()"
End If
End If
End If
End If
If cell.Column = 2 Then
If cell.Offset(1, 1) = "" Then
cell.Offset(0, 1).Formula = "=NA()"
If cell.Offset(1, 2) = "" Then
cell.Offset(0, 2).Formula = "=NA()"
End If
End If
End If
If cell.Column = 3 Then
If cell.Offset(1, 1) = "" Then
cell.Offset(0, 1).Formula = "=NA()"
End If
End If
If cell.Column > 2 Then
If IsEmpty(cell.Offset(-1, -1)) Then
cell.Offset(0, -1).Formula = "=NA()"
If cell.Column > 3 Then
If IsEmpty(cell.Offset(-1, -2)) Then _
cell.Offset(0, -2).Formula = "=NA()"
End If
End If
End If
Next
Columns("A").SpecialCells(xlBlanks).Delete
Columns("A").SpecialCells(xlFormulas, _
xlErrors).ClearContents
End Sub