Insert Row

[Seeker]

I have following code done by using Macro recorder. It halts for several
minutes before it produce my report, is there any way to speed up this
process please? On top, I would like to add a blank row between different
sets of data (different no. of row within each set of data), how can I do
that?
Example:
Row 1 AA
Row 2 AA
Row 3 (auto add this blank row)
Row 4 BB
Row 5 BB
Row 6 (auto add this blank row)
Row 7 CC


Sub Macro2()
' Print Records
'---------Select & Sort valid Data -----------
Sheets("Records").Visible = True
Sheets("Records").Select
Range("A2:AE65536").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("I2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, SortMethod:=xlStroke,
DataOption1:= _
xlSortNormal, DataOption2:=xlSortNormal
Selection.AutoFilter Field:=3, Criteria1:="<>"



'-------Set print area & Heading Title--------
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With

With ActiveSheet
.PageSetup.PrintArea = Intersect(.UsedRange, Range("A:O")).Address
End With


'-----------Unhide Data----------
ActiveWindow.SelectedSheets.PrintPreview
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("Records").Select
Selection.AutoFilter
Range("A2:AE65536").Select
Range("A2:AE65536").Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
SortMethod:=xlStroke, DataOption1:=xlSortNormal

Sheets("Records").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Oda Input").Select
Range("F2").Select
ActiveWorkbook.Save
End Sub

 

[Seeker]

Dear Volunteers,
I found a script in this forum as follow which should meet my needs in
adding rows,
should I place it just before '--Set print area & Heading Title--? According
to the writer, he assumes column A is the one with the data but my data is in
column B, so how should I modify this script please?

Dim i As Long
With Application
..Calculation = xlManual
..ScreenUpdating = False
End With
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i - 1, 1) <> Cells(i, 1) Then _
Cells(i, 1).Resize(1, 1).EntireRow.Insert
Next i
With Application
..Calculation = xlAutomatic
..ScreenUpdating = True
End With

 

[Jacob Skaria]

The below code will insert a complete row for between sections referring
ColB. Test this separately and then add to your code


Dim lngRow As Long
For lngRow = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If Range("B" & lngRow) <> Range("B" & lngRow - 1) Then
Rows(lngRow).EntireRow.Insert
End If
Next


If this post helps click Yes