How to do this? Thanks

I have an Excel workbook with the contact information in it, I need to
re-arrange it in orfder to to do some data search. The layout of the data is
in a single column as follow:

Name1 (font:Arial size:10 and Bold)
Address1 (font:Times New Roman size:10 Not Bold)
Address1.1 (font:Times New Roman size:10 Not Bold)
City1 (font:Times New Roman size:10 Not Bold)
Name2 (font:Arial size:10 and Bold)
Address2 (font:Times New Roman size:10 Not Bold)
Address2.2 (font:Times New Roman size:10 Not Bold)
City2 (font:Times New Roman size:10 Not Bold)
..
..
..
and so on

The only trick is for some of the contact it does not have the second line
of the address (i.e. Address1.1) and the contact information is shown as
follow:

Name1 (font:Arial size:10 and Bold)
Address1 (font:Times New Roman size:10 Not Bold)
City1 (font:Times New Roman size:10 Not Bold)
Name2 (font:Arial size:10 and Bold)
Address2 (font:Times New Roman size:10 Not Bold)
Address2.2 (font:Times New Roman size:10 Not Bold)
City2 (font:Times New Roman size:10 Not Bold)

I need to put the "AddressX" and "AddressX.X" and "CityX" into a column and
it will take me forever if iI have to copy and paste it one by one. Is there
a way I can use the vba code to achieve this? Thanks.

Also the "NameX" can be appeared twice for a single contact as follow:

> Name1 (font:Arial size:10 and Bold)
> Address1 (font:Times New Roman size:10 Not Bold)
> Address1.1 (font:Times New Roman size:10 Not Bold)
> City1 (font:Times New Roman size:10 Not Bold)
> Name2 (font:Arial size:10 and Bold)
> Name2.2 (font:Arial size:10 and Bold)
> Address2 (font:Times New Roman size:10 Not Bold)
> Address2.2 (font:Times New Roman size:10 Not Bold)
> City2 (font:Times New Roman size:10 Not Bold)


"Paul" <paul_mak@shaw.ca> wrote in message
news:egoMpZMOGHA.456@TK2MSFTNGP15.phx.gbl...
>I have an Excel workbook with the contact information in it, I need to
>re-arrange it in orfder to to do some data search. The layout of the data
>is in a single column as follow:
>
> Name1 (font:Arial size:10 and Bold)
> Address1 (font:Times New Roman size:10 Not Bold)
> Address1.1 (font:Times New Roman size:10 Not Bold)
> City1 (font:Times New Roman size:10 Not Bold)
> Name2 (font:Arial size:10 and Bold)
> Address2 (font:Times New Roman size:10 Not Bold)
> Address2.2 (font:Times New Roman size:10 Not Bold)
> City2 (font:Times New Roman size:10 Not Bold)
> .
> .
> .
> and so on
>
> The only trick is for some of the contact it does not have the second line
> of the address (i.e. Address1.1) and the contact information is shown as
> follow:
>
> Name1 (font:Arial size:10 and Bold)
> Address1 (font:Times New Roman size:10 Not Bold)
> City1 (font:Times New Roman size:10 Not Bold)
> Name2 (font:Arial size:10 and Bold)
> Address2 (font:Times New Roman size:10 Not Bold)
> Address2.2 (font:Times New Roman size:10 Not Bold)
> City2 (font:Times New Roman size:10 Not Bold)
>
> I need to put the "AddressX" and "AddressX.X" and "CityX" into a column
> and it will take me forever if iI have to copy and paste it one by one. Is
> there a way I can use the vba code to achieve this? Thanks.
>

Sub HIJ()
Dim rng As Range, rng1 As Range
Dim cell As Range, rng3 as Range
Dim ar As Range
Columns("B:F").ClearContents
Set rng3 = Cells(Rows.Count, 1).End(xlUp)(2)
rng3.Value = "Dummy"
rng3.Font.Bold = True

Set rng1 = Range(Range("A1"), rng3)
For Each cell In rng1
If cell.Font.Bold = False Then
cell.Resize(1, 2).Insert shift:=xlToRight
End If
Next
Set rng = rng1.SpecialCells(xlConstants)
For Each ar In rng.Areas
If ar.Count > 1 Then
ar(2).Insert shift:=xlToRight
Else
ar.Offset(0, 1).Formula = "=na()"
End If
If ar(1).Row > 1 Then
ar(0, 1).Resize(1, 2).Insert shift:=xlToRight
End If
Next

Set rng = rng1.Offset(0, 2).SpecialCells(xlConstants)
rng.Select
For Each ar In rng.Areas
If ar.Count > 1 Then
ar(2).Insert shift:=xlToRight
Else
ar.Offset(0, 1).Formula = "=na()"
End If
Next
rng3.EntireRow.Delete
Columns("A:F").SpecialCells(xlBlanks).Delete _
shift:=xlShiftUp
Columns("A:F").SpecialCells(xlFormulas, _
xlErrors).ClearContents
End Sub

--
Regards,
Tom Ogilvy




--
Regards,
Tom Ogilvy




"Paul" <paul_mak@shaw.ca> wrote in message
news:%23vpb5dMOGHA.3064@TK2MSFTNGP10.phx.gbl...
> Also the "NameX" can be appeared twice for a single contact as follow:
>
> > Name1 (font:Arial size:10 and Bold)
> > Address1 (font:Times New Roman size:10 Not Bold)
> > Address1.1 (font:Times New Roman size:10 Not Bold)
> > City1 (font:Times New Roman size:10 Not Bold)
> > Name2 (font:Arial size:10 and Bold)
> > Name2.2 (font:Arial size:10 and Bold)
> > Address2 (font:Times New Roman size:10 Not Bold)
> > Address2.2 (font:Times New Roman size:10 Not Bold)
> > City2 (font:Times New Roman size:10 Not Bold)
>
>
> "Paul" <paul_mak@shaw.ca> wrote in message
> news:egoMpZMOGHA.456@TK2MSFTNGP15.phx.gbl...
> >I have an Excel workbook with the contact information in it, I need to
> >re-arrange it in orfder to to do some data search. The layout of the data
> >is in a single column as follow:
> >
> > Name1 (font:Arial size:10 and Bold)
> > Address1 (font:Times New Roman size:10 Not Bold)
> > Address1.1 (font:Times New Roman size:10 Not Bold)
> > City1 (font:Times New Roman size:10 Not Bold)
> > Name2 (font:Arial size:10 and Bold)
> > Address2 (font:Times New Roman size:10 Not Bold)
> > Address2.2 (font:Times New Roman size:10 Not Bold)
> > City2 (font:Times New Roman size:10 Not Bold)
> > .
> > .
> > .
> > and so on
> >
> > The only trick is for some of the contact it does not have the second
line
> > of the address (i.e. Address1.1) and the contact information is shown as
> > follow:
> >
> > Name1 (font:Arial size:10 and Bold)
> > Address1 (font:Times New Roman size:10 Not Bold)
> > City1 (font:Times New Roman size:10 Not Bold)
> > Name2 (font:Arial size:10 and Bold)
> > Address2 (font:Times New Roman size:10 Not Bold)
> > Address2.2 (font:Times New Roman size:10 Not Bold)
> > City2 (font:Times New Roman size:10 Not Bold)
> >
> > I need to put the "AddressX" and "AddressX.X" and "CityX" into a column
> > and it will take me forever if iI have to copy and paste it one by one.
Is
> > there a way I can use the vba code to achieve this? Thanks.
> >
>
>

Nice to learn
Columns("A:F").SpecialCells(xlBlanks).Delete shift:=xlShiftUp

Also saw twice
Cells(Rows.Count, 1).End(xlUp)(2)

For exercise, we tried this.
There are extra blank lines at the end, probably not worth programming steps
to eliminate

Sub t()
For i = 1 To Cells(65536, 1).End(xlUp).Row
If Range("A" & i + 1).Font.Bold = True Then
Range("A" & i + 1).Cut Range("b" & i)
Range("A" & i + 2).Cut Range("c" & i)
Range("A" & i + 3).Cut Range("d" & i)
Range("A" & i + 4).Cut Range("e" & i)
i = i + 4
End If

If Range("A" & i + 1).Font.Bold = False Then
Range("A" & i + 1).Cut Range("c" & i)
Range("A" & i + 2).Cut Range("d" & i)
Range("A" & i + 3).Cut Range("e" & i)
i = i + 3
End If

Next i

For i = i To 1 Step -1
If IsEmpty(Range("A" & i)) Then Rows(i).Delete
Next i

End Sub

Regards


"Tom Ogilvy" wrote:

> Sub HIJ()
> Dim rng As Range, rng1 As Range
> Dim cell As Range, rng3 as Range
> Dim ar As Range
> Columns("B:F").ClearContents
> Set rng3 = Cells(Rows.Count, 1).End(xlUp)(2)
> rng3.Value = "Dummy"
> rng3.Font.Bold = True
>
> Set rng1 = Range(Range("A1"), rng3)
> For Each cell In rng1
> If cell.Font.Bold = False Then
> cell.Resize(1, 2).Insert shift:=xlToRight
> End If
> Next
> Set rng = rng1.SpecialCells(xlConstants)
> For Each ar In rng.Areas
> If ar.Count > 1 Then
> ar(2).Insert shift:=xlToRight
> Else
> ar.Offset(0, 1).Formula = "=na()"
> End If
> If ar(1).Row > 1 Then
> ar(0, 1).Resize(1, 2).Insert shift:=xlToRight
> End If
> Next
>
> Set rng = rng1.Offset(0, 2).SpecialCells(xlConstants)
> rng.Select
> For Each ar In rng.Areas
> If ar.Count > 1 Then
> ar(2).Insert shift:=xlToRight
> Else
> ar.Offset(0, 1).Formula = "=na()"
> End If
> Next
> rng3.EntireRow.Delete
> Columns("A:F").SpecialCells(xlBlanks).Delete _
> shift:=xlShiftUp
> Columns("A:F").SpecialCells(xlFormulas, _
> xlErrors).ClearContents
> End Sub
>
> --
> Regards,
> Tom Ogilvy
>
>
>
>
> --
> Regards,
> Tom Ogilvy
>
>
>
>
> "Paul" <paul_mak@shaw.ca> wrote in message
> news:%23vpb5dMOGHA.3064@TK2MSFTNGP10.phx.gbl...
> > Also the "NameX" can be appeared twice for a single contact as follow:
> >
> > > Name1 (font:Arial size:10 and Bold)
> > > Address1 (font:Times New Roman size:10 Not Bold)
> > > Address1.1 (font:Times New Roman size:10 Not Bold)
> > > City1 (font:Times New Roman size:10 Not Bold)
> > > Name2 (font:Arial size:10 and Bold)
> > > Name2.2 (font:Arial size:10 and Bold)
> > > Address2 (font:Times New Roman size:10 Not Bold)
> > > Address2.2 (font:Times New Roman size:10 Not Bold)
> > > City2 (font:Times New Roman size:10 Not Bold)
> >
> >
> > "Paul" <paul_mak@shaw.ca> wrote in message
> > news:egoMpZMOGHA.456@TK2MSFTNGP15.phx.gbl...
> > >I have an Excel workbook with the contact information in it, I need to
> > >re-arrange it in orfder to to do some data search. The layout of the data
> > >is in a single column as follow:
> > >
> > > Name1 (font:Arial size:10 and Bold)
> > > Address1 (font:Times New Roman size:10 Not Bold)
> > > Address1.1 (font:Times New Roman size:10 Not Bold)
> > > City1 (font:Times New Roman size:10 Not Bold)
> > > Name2 (font:Arial size:10 and Bold)
> > > Address2 (font:Times New Roman size:10 Not Bold)
> > > Address2.2 (font:Times New Roman size:10 Not Bold)
> > > City2 (font:Times New Roman size:10 Not Bold)
> > > .
> > > .
> > > .
> > > and so on
> > >
> > > The only trick is for some of the contact it does not have the second
> line
> > > of the address (i.e. Address1.1) and the contact information is shown as
> > > follow:
> > >
> > > Name1 (font:Arial size:10 and Bold)
> > > Address1 (font:Times New Roman size:10 Not Bold)
> > > City1 (font:Times New Roman size:10 Not Bold)
> > > Name2 (font:Arial size:10 and Bold)
> > > Address2 (font:Times New Roman size:10 Not Bold)
> > > Address2.2 (font:Times New Roman size:10 Not Bold)
> > > City2 (font:Times New Roman size:10 Not Bold)
> > >
> > > I need to put the "AddressX" and "AddressX.X" and "CityX" into a column
> > > and it will take me forever if iI have to copy and paste it one by one.
> Is
> > > there a way I can use the vba code to achieve this? Thanks.
> > >
> >
> >
>
>
>

Didn't seem to cover all the contingencies for me, but maybe we understand
the problem differently.

--
Regards,
Tom Ogilvy


"PY & Associates" <PYAssociates@discussions.microsoft.com> wrote in message
news:79D1A76B-7448-4988-AA84-F3C9963690A2@microsoft.com...
> Nice to learn
> Columns("A:F").SpecialCells(xlBlanks).Delete shift:=xlShiftUp
>
> Also saw twice
> Cells(Rows.Count, 1).End(xlUp)(2)
>
> For exercise, we tried this.
> There are extra blank lines at the end, probably not worth programming
steps
> to eliminate
>
> Sub t()
> For i = 1 To Cells(65536, 1).End(xlUp).Row
> If Range("A" & i + 1).Font.Bold = True Then
> Range("A" & i + 1).Cut Range("b" & i)
> Range("A" & i + 2).Cut Range("c" & i)
> Range("A" & i + 3).Cut Range("d" & i)
> Range("A" & i + 4).Cut Range("e" & i)
> i = i + 4
> End If
>
> If Range("A" & i + 1).Font.Bold = False Then
> Range("A" & i + 1).Cut Range("c" & i)
> Range("A" & i + 2).Cut Range("d" & i)
> Range("A" & i + 3).Cut Range("e" & i)
> i = i + 3
> End If
>
> Next i
>
> For i = i To 1 Step -1
> If IsEmpty(Range("A" & i)) Then Rows(i).Delete
> Next i
>
> End Sub
>
> Regards
>
>
> "Tom Ogilvy" wrote:
>
> > Sub HIJ()
> > Dim rng As Range, rng1 As Range
> > Dim cell As Range, rng3 as Range
> > Dim ar As Range
> > Columns("B:F").ClearContents
> > Set rng3 = Cells(Rows.Count, 1).End(xlUp)(2)
> > rng3.Value = "Dummy"
> > rng3.Font.Bold = True
> >
> > Set rng1 = Range(Range("A1"), rng3)
> > For Each cell In rng1
> > If cell.Font.Bold = False Then
> > cell.Resize(1, 2).Insert shift:=xlToRight
> > End If
> > Next
> > Set rng = rng1.SpecialCells(xlConstants)
> > For Each ar In rng.Areas
> > If ar.Count > 1 Then
> > ar(2).Insert shift:=xlToRight
> > Else
> > ar.Offset(0, 1).Formula = "=na()"
> > End If
> > If ar(1).Row > 1 Then
> > ar(0, 1).Resize(1, 2).Insert shift:=xlToRight
> > End If
> > Next
> >
> > Set rng = rng1.Offset(0, 2).SpecialCells(xlConstants)
> > rng.Select
> > For Each ar In rng.Areas
> > If ar.Count > 1 Then
> > ar(2).Insert shift:=xlToRight
> > Else
> > ar.Offset(0, 1).Formula = "=na()"
> > End If
> > Next
> > rng3.EntireRow.Delete
> > Columns("A:F").SpecialCells(xlBlanks).Delete _
> > shift:=xlShiftUp
> > Columns("A:F").SpecialCells(xlFormulas, _
> > xlErrors).ClearContents
> > End Sub
> >
> > --
> > Regards,
> > Tom Ogilvy
> >
> >
> >
> >
> > --
> > Regards,
> > Tom Ogilvy
> >
> >
> >
> >
> > "Paul" <paul_mak@shaw.ca> wrote in message
> > news:%23vpb5dMOGHA.3064@TK2MSFTNGP10.phx.gbl...
> > > Also the "NameX" can be appeared twice for a single contact as follow:
> > >
> > > > Name1 (font:Arial size:10 and Bold)
> > > > Address1 (font:Times New Roman size:10 Not Bold)
> > > > Address1.1 (font:Times New Roman size:10 Not Bold)
> > > > City1 (font:Times New Roman size:10 Not Bold)
> > > > Name2 (font:Arial size:10 and Bold)
> > > > Name2.2 (font:Arial size:10 and Bold)
> > > > Address2 (font:Times New Roman size:10 Not Bold)
> > > > Address2.2 (font:Times New Roman size:10 Not Bold)
> > > > City2 (font:Times New Roman size:10 Not Bold)
> > >
> > >
> > > "Paul" <paul_mak@shaw.ca> wrote in message
> > > news:egoMpZMOGHA.456@TK2MSFTNGP15.phx.gbl...
> > > >I have an Excel workbook with the contact information in it, I need
to
> > > >re-arrange it in orfder to to do some data search. The layout of the
data
> > > >is in a single column as follow:
> > > >
> > > > Name1 (font:Arial size:10 and Bold)
> > > > Address1 (font:Times New Roman size:10 Not Bold)
> > > > Address1.1 (font:Times New Roman size:10 Not Bold)
> > > > City1 (font:Times New Roman size:10 Not Bold)
> > > > Name2 (font:Arial size:10 and Bold)
> > > > Address2 (font:Times New Roman size:10 Not Bold)
> > > > Address2.2 (font:Times New Roman size:10 Not Bold)
> > > > City2 (font:Times New Roman size:10 Not Bold)
> > > > .
> > > > .
> > > > .
> > > > and so on
> > > >
> > > > The only trick is for some of the contact it does not have the
second
> > line
> > > > of the address (i.e. Address1.1) and the contact information is
shown as
> > > > follow:
> > > >
> > > > Name1 (font:Arial size:10 and Bold)
> > > > Address1 (font:Times New Roman size:10 Not Bold)
> > > > City1 (font:Times New Roman size:10 Not Bold)
> > > > Name2 (font:Arial size:10 and Bold)
> > > > Address2 (font:Times New Roman size:10 Not Bold)
> > > > Address2.2 (font:Times New Roman size:10 Not Bold)
> > > > City2 (font:Times New Roman size:10 Not Bold)
> > > >
> > > > I need to put the "AddressX" and "AddressX.X" and "CityX" into a
column
> > > > and it will take me forever if iI have to copy and paste it one by
one.
> > Is
> > > > there a way I can use the vba code to achieve this? Thanks.
> > > >
> > >
> > >
> >
> >
> >

Hi Tom:

It works and it does exactly what I want.

Thank you.

Paul
"Tom Ogilvy" <twogilvy@msn.com> wrote in message
news:utLH2NNOGHA.3196@TK2MSFTNGP09.phx.gbl...
> Sub HIJ()
> Dim rng As Range, rng1 As Range
> Dim cell As Range, rng3 as Range
> Dim ar As Range
> Columns("B:F").ClearContents
> Set rng3 = Cells(Rows.Count, 1).End(xlUp)(2)
> rng3.Value = "Dummy"
> rng3.Font.Bold = True
>
> Set rng1 = Range(Range("A1"), rng3)
> For Each cell In rng1
> If cell.Font.Bold = False Then
> cell.Resize(1, 2).Insert shift:=xlToRight
> End If
> Next
> Set rng = rng1.SpecialCells(xlConstants)
> For Each ar In rng.Areas
> If ar.Count > 1 Then
> ar(2).Insert shift:=xlToRight
> Else
> ar.Offset(0, 1).Formula = "=na()"
> End If
> If ar(1).Row > 1 Then
> ar(0, 1).Resize(1, 2).Insert shift:=xlToRight
> End If
> Next
>
> Set rng = rng1.Offset(0, 2).SpecialCells(xlConstants)
> rng.Select
> For Each ar In rng.Areas
> If ar.Count > 1 Then
> ar(2).Insert shift:=xlToRight
> Else
> ar.Offset(0, 1).Formula = "=na()"
> End If
> Next
> rng3.EntireRow.Delete
> Columns("A:F").SpecialCells(xlBlanks).Delete _
> shift:=xlShiftUp
> Columns("A:F").SpecialCells(xlFormulas, _
> xlErrors).ClearContents
> End Sub
>
> --
> Regards,
> Tom Ogilvy
>
>
>
>
> --
> Regards,
> Tom Ogilvy
>
>
>
>
> "Paul" <paul_mak@shaw.ca> wrote in message
> news:%23vpb5dMOGHA.3064@TK2MSFTNGP10.phx.gbl...
>> Also the "NameX" can be appeared twice for a single contact as follow:
>>
>> > Name1 (font:Arial size:10 and Bold)
>> > Address1 (font:Times New Roman size:10 Not Bold)
>> > Address1.1 (font:Times New Roman size:10 Not Bold)
>> > City1 (font:Times New Roman size:10 Not Bold)
>> > Name2 (font:Arial size:10 and Bold)
>> > Name2.2 (font:Arial size:10 and Bold)
>> > Address2 (font:Times New Roman size:10 Not Bold)
>> > Address2.2 (font:Times New Roman size:10 Not Bold)
>> > City2 (font:Times New Roman size:10 Not Bold)
>>
>>
>> "Paul" <paul_mak@shaw.ca> wrote in message
>> news:egoMpZMOGHA.456@TK2MSFTNGP15.phx.gbl...
>> >I have an Excel workbook with the contact information in it, I need to
>> >re-arrange it in orfder to to do some data search. The layout of the
>> >data
>> >is in a single column as follow:
>> >
>> > Name1 (font:Arial size:10 and Bold)
>> > Address1 (font:Times New Roman size:10 Not Bold)
>> > Address1.1 (font:Times New Roman size:10 Not Bold)
>> > City1 (font:Times New Roman size:10 Not Bold)
>> > Name2 (font:Arial size:10 and Bold)
>> > Address2 (font:Times New Roman size:10 Not Bold)
>> > Address2.2 (font:Times New Roman size:10 Not Bold)
>> > City2 (font:Times New Roman size:10 Not Bold)
>> > .
>> > .
>> > .
>> > and so on
>> >
>> > The only trick is for some of the contact it does not have the second
> line
>> > of the address (i.e. Address1.1) and the contact information is shown
>> > as
>> > follow:
>> >
>> > Name1 (font:Arial size:10 and Bold)
>> > Address1 (font:Times New Roman size:10 Not Bold)
>> > City1 (font:Times New Roman size:10 Not Bold)
>> > Name2 (font:Arial size:10 and Bold)
>> > Address2 (font:Times New Roman size:10 Not Bold)
>> > Address2.2 (font:Times New Roman size:10 Not Bold)
>> > City2 (font:Times New Roman size:10 Not Bold)
>> >
>> > I need to put the "AddressX" and "AddressX.X" and "CityX" into a column
>> > and it will take me forever if iI have to copy and paste it one by one.
> Is
>> > there a way I can use the vba code to achieve this? Thanks.
>> >
>>
>>
>
>

Hi Tom:

I'm really appreciated for what you have provided to my problem so far. I
did come across a condition that I am not sure if you can give me further
advice. The condition is the "Name" for each of the contact could have
multiple "Names" on it i.e. more than 2 as I posted incorrectly on the
newsgroup yesterday. Is there a way to create additional column depends on
the number of the "Name" appears on each of the contact? Many thanks.


"Tom Ogilvy" <twogilvy@msn.com> wrote in message
news:utLH2NNOGHA.3196@TK2MSFTNGP09.phx.gbl...
> Sub HIJ()
> Dim rng As Range, rng1 As Range
> Dim cell As Range, rng3 as Range
> Dim ar As Range
> Columns("B:F").ClearContents
> Set rng3 = Cells(Rows.Count, 1).End(xlUp)(2)
> rng3.Value = "Dummy"
> rng3.Font.Bold = True
>
> Set rng1 = Range(Range("A1"), rng3)
> For Each cell In rng1
> If cell.Font.Bold = False Then
> cell.Resize(1, 2).Insert shift:=xlToRight
> End If
> Next
> Set rng = rng1.SpecialCells(xlConstants)
> For Each ar In rng.Areas
> If ar.Count > 1 Then
> ar(2).Insert shift:=xlToRight
> Else
> ar.Offset(0, 1).Formula = "=na()"
> End If
> If ar(1).Row > 1 Then
> ar(0, 1).Resize(1, 2).Insert shift:=xlToRight
> End If
> Next
>
> Set rng = rng1.Offset(0, 2).SpecialCells(xlConstants)
> rng.Select
> For Each ar In rng.Areas
> If ar.Count > 1 Then
> ar(2).Insert shift:=xlToRight
> Else
> ar.Offset(0, 1).Formula = "=na()"
> End If
> Next
> rng3.EntireRow.Delete
> Columns("A:F").SpecialCells(xlBlanks).Delete _
> shift:=xlShiftUp
> Columns("A:F").SpecialCells(xlFormulas, _
> xlErrors).ClearContents
> End Sub
>
> --
> Regards,
> Tom Ogilvy
>
>
>
>
> --
> Regards,
> Tom Ogilvy
>
>
>
>
> "Paul" <paul_mak@shaw.ca> wrote in message
> news:%23vpb5dMOGHA.3064@TK2MSFTNGP10.phx.gbl...
>> Also the "NameX" can be appeared twice for a single contact as follow:
>>
>> > Name1 (font:Arial size:10 and Bold)
>> > Address1 (font:Times New Roman size:10 Not Bold)
>> > Address1.1 (font:Times New Roman size:10 Not Bold)
>> > City1 (font:Times New Roman size:10 Not Bold)
>> > Name2 (font:Arial size:10 and Bold)
>> > Name2.2 (font:Arial size:10 and Bold)
>> > Address2 (font:Times New Roman size:10 Not Bold)
>> > Address2.2 (font:Times New Roman size:10 Not Bold)
>> > City2 (font:Times New Roman size:10 Not Bold)
>>
>>
>> "Paul" <paul_mak@shaw.ca> wrote in message
>> news:egoMpZMOGHA.456@TK2MSFTNGP15.phx.gbl...
>> >I have an Excel workbook with the contact information in it, I need to
>> >re-arrange it in orfder to to do some data search. The layout of the
>> >data
>> >is in a single column as follow:
>> >
>> > Name1 (font:Arial size:10 and Bold)
>> > Address1 (font:Times New Roman size:10 Not Bold)
>> > Address1.1 (font:Times New Roman size:10 Not Bold)
>> > City1 (font:Times New Roman size:10 Not Bold)
>> > Name2 (font:Arial size:10 and Bold)
>> > Address2 (font:Times New Roman size:10 Not Bold)
>> > Address2.2 (font:Times New Roman size:10 Not Bold)
>> > City2 (font:Times New Roman size:10 Not Bold)
>> > .
>> > .
>> > .
>> > and so on
>> >
>> > The only trick is for some of the contact it does not have the second
> line
>> > of the address (i.e. Address1.1) and the contact information is shown
>> > as
>> > follow:
>> >
>> > Name1 (font:Arial size:10 and Bold)
>> > Address1 (font:Times New Roman size:10 Not Bold)
>> > City1 (font:Times New Roman size:10 Not Bold)
>> > Name2 (font:Arial size:10 and Bold)
>> > Address2 (font:Times New Roman size:10 Not Bold)
>> > Address2.2 (font:Times New Roman size:10 Not Bold)
>> > City2 (font:Times New Roman size:10 Not Bold)
>> >
>> > I need to put the "AddressX" and "AddressX.X" and "CityX" into a column
>> > and it will take me forever if iI have to copy and paste it one by one.
> Is
>> > there a way I can use the vba code to achieve this? Thanks.
>> >
>>
>>
>
>

test

test

Try this:

Sub HIJ()
Dim rng As Range, rng1 As Range
Dim cell As Range, rng3 As Range
Dim ar As Range, maxcnt As Long
Dim k As Long
Columns("B:F").ClearContents
Set rng3 = Cells(Rows.Count, 1).End(xlUp)(2)
rng3.Value = "Dummy"
rng3.Font.Bold = True

Set rng1 = Range(Range("A1"), rng3)
For Each cell In rng1
If cell.Font.Bold = False Then
cell.Resize(1, 1).Insert shift:=xlToRight
End If
Next
maxcnt = 0
Set rng = rng1.SpecialCells(xlConstants)
For Each ar In rng.Areas
If ar.Count > maxcnt Then
maxcnt = ar.Count
End If
Next
Columns(2).Resize(, maxcnt - 1).Insert
For Each ar In rng.Areas
If ar.Count > 1 Then
For k = 2 To ar.Count
ar(k).Resize(1, k - 1).Insert shift:=xlToRight
Next
End If
If ar.Count < maxcnt Then
ar(1).Offset(0, ar.Count).Resize(1, maxcnt - ar.Count) _
.Formula = "=na()"
End If
' ar(1).Offset(0, 1).Resize(1, maxcnt - 1).Formula = _
"=na()"

If ar(1).Row > 1 Then
ar(1).Offset(-1, maxcnt).Resize(1, 2).Insert _
shift:=xlToRight
End If
Next
Set rng = rng1.Offset(0, maxcnt).SpecialCells(xlConstants)
rng.Select
For Each ar In rng.Areas
If ar.Count > 1 Then
ar(2).Insert shift:=xlToRight
Else
ar.Offset(0, 1).Formula = "=na()"
End If
Next
rng3.EntireRow.Delete
Columns("A:M").SpecialCells(xlBlanks).Delete _
shift:=xlShiftUp
Columns("A:M").SpecialCells(xlFormulas, _
xlErrors).ClearContents
End Sub


--
Regards,
Tom Ogilvy

"Paul" <paul_mak@shaw.ca> wrote in message
news:%239CNB2WOGHA.1028@TK2MSFTNGP11.phx.gbl...
> Hi Tom:
>
> I'm really appreciated for what you have provided to my problem so far. I
> did come across a condition that I am not sure if you can give me further
> advice. The condition is the "Name" for each of the contact could have
> multiple "Names" on it i.e. more than 2 as I posted incorrectly on the
> newsgroup yesterday. Is there a way to create additional column depends on
> the number of the "Name" appears on each of the contact? Many thanks.
>
>
> "Tom Ogilvy" <twogilvy@msn.com> wrote in message
> news:utLH2NNOGHA.3196@TK2MSFTNGP09.phx.gbl...
> > Sub HIJ()
> > Dim rng As Range, rng1 As Range
> > Dim cell As Range, rng3 as Range
> > Dim ar As Range
> > Columns("B:F").ClearContents
> > Set rng3 = Cells(Rows.Count, 1).End(xlUp)(2)
> > rng3.Value = "Dummy"
> > rng3.Font.Bold = True
> >
> > Set rng1 = Range(Range("A1"), rng3)
> > For Each cell In rng1
> > If cell.Font.Bold = False Then
> > cell.Resize(1, 2).Insert shift:=xlToRight
> > End If
> > Next
> > Set rng = rng1.SpecialCells(xlConstants)
> > For Each ar In rng.Areas
> > If ar.Count > 1 Then
> > ar(2).Insert shift:=xlToRight
> > Else
> > ar.Offset(0, 1).Formula = "=na()"
> > End If
> > If ar(1).Row > 1 Then
> > ar(0, 1).Resize(1, 2).Insert shift:=xlToRight
> > End If
> > Next
> >
> > Set rng = rng1.Offset(0, 2).SpecialCells(xlConstants)
> > rng.Select
> > For Each ar In rng.Areas
> > If ar.Count > 1 Then
> > ar(2).Insert shift:=xlToRight
> > Else
> > ar.Offset(0, 1).Formula = "=na()"
> > End If
> > Next
> > rng3.EntireRow.Delete
> > Columns("A:F").SpecialCells(xlBlanks).Delete _
> > shift:=xlShiftUp
> > Columns("A:F").SpecialCells(xlFormulas, _
> > xlErrors).ClearContents
> > End Sub
> >
> > --
> > Regards,
> > Tom Ogilvy
> >
> >
> >
> >
> > --
> > Regards,
> > Tom Ogilvy
> >
> >
> >
> >
> > "Paul" <paul_mak@shaw.ca> wrote in message
> > news:%23vpb5dMOGHA.3064@TK2MSFTNGP10.phx.gbl...
> >> Also the "NameX" can be appeared twice for a single contact as follow:
> >>
> >> > Name1 (font:Arial size:10 and Bold)
> >> > Address1 (font:Times New Roman size:10 Not Bold)
> >> > Address1.1 (font:Times New Roman size:10 Not Bold)
> >> > City1 (font:Times New Roman size:10 Not Bold)
> >> > Name2 (font:Arial size:10 and Bold)
> >> > Name2.2 (font:Arial size:10 and Bold)
> >> > Address2 (font:Times New Roman size:10 Not Bold)
> >> > Address2.2 (font:Times New Roman size:10 Not Bold)
> >> > City2 (font:Times New Roman size:10 Not Bold)
> >>
> >>
> >> "Paul" <paul_mak@shaw.ca> wrote in message
> >> news:egoMpZMOGHA.456@TK2MSFTNGP15.phx.gbl...
> >> >I have an Excel workbook with the contact information in it, I need
to
> >> >re-arrange it in orfder to to do some data search. The layout of the
> >> >data
> >> >is in a single column as follow:
> >> >
> >> > Name1 (font:Arial size:10 and Bold)
> >> > Address1 (font:Times New Roman size:10 Not Bold)
> >> > Address1.1 (font:Times New Roman size:10 Not Bold)
> >> > City1 (font:Times New Roman size:10 Not Bold)
> >> > Name2 (font:Arial size:10 and Bold)
> >> > Address2 (font:Times New Roman size:10 Not Bold)
> >> > Address2.2 (font:Times New Roman size:10 Not Bold)
> >> > City2 (font:Times New Roman size:10 Not Bold)
> >> > .
> >> > .
> >> > .
> >> > and so on
> >> >
> >> > The only trick is for some of the contact it does not have the second
> > line
> >> > of the address (i.e. Address1.1) and the contact information is shown
> >> > as
> >> > follow:
> >> >
> >> > Name1 (font:Arial size:10 and Bold)
> >> > Address1 (font:Times New Roman size:10 Not Bold)
> >> > City1 (font:Times New Roman size:10 Not Bold)
> >> > Name2 (font:Arial size:10 and Bold)
> >> > Address2 (font:Times New Roman size:10 Not Bold)
> >> > Address2.2 (font:Times New Roman size:10 Not Bold)
> >> > City2 (font:Times New Roman size:10 Not Bold)
> >> >
> >> > I need to put the "AddressX" and "AddressX.X" and "CityX" into a
column
> >> > and it will take me forever if iI have to copy and paste it one by
one.
> > Is
> >> > there a way I can use the vba code to achieve this? Thanks.
> >> >
> >>
> >>
> >
> >
>
>