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.
> > >
> >
> >
>
>
>
Bookmarks