How to insert a blank row between dates

[muss1210]

Hello

Newbie here,

i have a list of orders than need to be done in date order and there is multiple orders on the same date.

how do i insert a blank row to seperate the dates

as a example

from this
14/4 etccc
14/4
14/4
15/4 etcc
15/4
15/4

to this
14/4 etccc
14/4
14/4

15/4 etcc
15/4
15/4

16/4
16/4
16/4

and so on

Could the results then be put into a new sheet leaving the original data?

Many thanks in advance

 

[Joe4]

Welcome to the Board!

Something like this...

Sub MyMacro()


    Dim myLastRow As Long
    Dim myRow As Long
    
    Application.ScreenUpdating = False


'   Copy data from Sheet1 to Sheet2 (assuming data starts in cel1 A1 and is continuous with no gaps)
    Sheets("Sheet1").Select
    Range("A1").CurrentRegion.Copy
    Sheets("Sheet2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
'   Find last row in column A
    myLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through rows starting at bottom
    For myRow = myLastRow To 2 Step -1
'       Check to see if value in column A different from above row
        If Cells(myRow, "A") <> Cells(myRow - 1, "A") Then
'           Insert row
            Rows(myRow).Insert
        End If
    Next myRow
    
    Application.ScreenUpdating = True


End Sub

 

[muss1210]

thanks for the reply

When i have run the script it doesnt put in a blank row between the different dates.

It does copy the information from sheet 1 into sheet 2 but starts teh information at row 46 and column D

 

[mirabeau]

You can try this.
It takes dates as being listed down column A of the active worksheet, but can easily modify to another column if need be

Sub insert_blank_row()

Dim r As Long, c As Long, a, u(), i As Long, k As Long

r = Cells.Find("*", , , , xlByRows, xlPrevious).Row
c = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
ReDim u(1 To r, 1 To 1)
Cells(1).Resize(r, c).Sort Cells(1), Header:=xlNo
a = Cells(1).Resize(r + 1)
Cells(c + 1) = 1: Cells(c + 1).Resize(r).DataSeries

For i = 1 To r
    If Not a(i, 1) = a(i + 1, 1) Then k = k + 1: u(k, 1) = i
Next i

Cells(r + 1, c + 1).Resize(k) = u
Cells(1).Resize(r + k, c + 1).Sort Cells(c + 1), Header:=xlNo
Cells(c + 1).Resize(r + k).ClearContents

End Sub

 

[muss1210]

close , this inserts a blank row between every line

i need to keep the dates grouped togther

Also row A1 need to left alone as this has the column headers

thanks in advance

 

[Joe4]

thanks for the reply

When i have run the script it doesnt put in a blank row between the different dates.

It does copy the information from sheet 1 into sheet 2 but starts the information at row 46 and column D

It worked for me, but I was assuming that your data is in column A and B and starts on row 1.
What is the structure of your data?

 

[muss1210]

@Joe4

the data starts in A1
row 1 contains the column headers
column A contains the date after i sort
before i sort the date is in column F
i have moved teh column with vba

thanks in advance

 

[mirabeau]

close , this inserts a blank row between every line

i need to keep the dates grouped togther

Also row A1 need to left alone as this has the column headers

thanks in advance

The code in post#4 worked on your data as you posted it in post#1.

however, try this

Sub insert_blank_row2()

Dim r As Long, c As Long, a, u(), i As Long, k As Long

r = Cells.Find("*", , , , xlByRows, xlPrevious).Row
c = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
ReDim u(1 To r, 1 To 1)
Cells(1).Resize(r, c).Sort Cells(1), Header:=xlYes
a = Cells(1).Resize(r + 1)
Cells(c + 1) = 1: Cells(c + 1).Resize(r).DataSeries

For i = 2 To r
    If Not Int(a(i, 1)) = Int(a(i + 1, 1)) Then k = k + 1: u(k, 1) = i
Next i

Cells(r + 1, c + 1).Resize(k) = u
Cells(1).Resize(r + k, c + 1).Sort Cells(c + 1), Header:=xlNo
Cells(c + 1).Resize(r + k).ClearContents

End Sub

 

[Joe4]

before i sort the date is in column F
i have moved teh column with <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">vba</acronym>

Ah, important details that were left out!
Simply replace all my references to column "A" in my code to "F".