Auto inserting a row between groups of data or have code to run on each group of data

[TheNarddog]

Hi

On my sheet I have headings on row 2, columns in use from A to I and rows of data from row 3 and below.

Column A is "Date", column B to I aren't significant.

So I could have any number rows of a certain dd/mm/yy, then any number of rows of another dd/mm/yy and it keeps going like this down the sheet.

At the moment I use empty rows to separate different groups of dates.

Another user has helped me massively to produce the following code to sort my data and automate my actions. The way it sorts though gets rid of my gaps and I struggle to easily see the difference between each group of dd/mm/yy that are the same.

So I'm hoping either:

1) There could be someway of using the code below then adding a way to insert an empty row between dd/mm/yy's automatically

or

2) Have the code below sort one group of dd/mm/yy's that are the same date, then I'll already have the empty row for a gap between dates, then the code works again on the next group of dates that are the same.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Me.Range("G3", Cells(Rows.Count, "H").End(3)), Target) Is Nothing Then
        Cancel = True
        If Target.Column = 7 And Target.Value <> "Yes" Then Target.Value = "Yes"
        If Target.Column = 8 Then Target.Value = Format(Now(), "dd/mm/yyyy")    '<< change format to suit
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    Dim LRow As Long
    LRow = Cells.Find("*", , xlFormulas, , 1, 2).Row
    If Not Intersect(Me.Range("A3:I" & LRow), Target) Is Nothing Then
        Application.EnableEvents = False
        With Me.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("G2"), Order:=xlAscending
            .SortFields.Add Key:=Range("A2"), Order:=xlAscending
            .SortFields.Add Key:=Range("F2"), Order:=xlAscending
            .SortFields.Add Key:=Range("E2"), Order:=xlAscending
            .SetRange Range("A3:I" & LRow)
            .Apply
        End With
    End If
    Application.EnableEvents = True
End Sub

 

[YetAnotherDave]

After you have sorted your data, cycle through the cells in the date column testing each cell against the cell above it to see if they have equal values. At the point where they are different, insert a blank row. you can use a for-each loop or a do loop to accomplish this, or a combination of both. I don't have time to post the code to do this right now but I can after I get out of a meeting.

 

[kevin9999]

Hi

On my sheet I have headings on row 2, columns in use from A to I and rows of data from row 3 and below.

Column A is "Date", column B to I aren't significant.

So I could have any number rows of a certain dd/mm/yy, then any number of rows of another dd/mm/yy and it keeps going like this down the sheet.

At the moment I use empty rows to separate different groups of dates.

Another user has helped me massively to produce the following code to sort my data and automate my actions. The way it sorts though gets rid of my gaps and I struggle to easily see the difference between each group of dd/mm/yy that are the same.

So I'm hoping either:

1) There could be someway of using the code below then adding a way to insert an empty row between dd/mm/yy's automatically

or

2) Have the code below sort one group of dd/mm/yy's that are the same date, then I'll already have the empty row for a gap between dates, then the code works again on the next group of dates that are the same.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Me.Range("G3", Cells(Rows.Count, "H").End(3)), Target) Is Nothing Then
        Cancel = True
        If Target.Column = 7 And Target.Value <> "Yes" Then Target.Value = "Yes"
        If Target.Column = 8 Then Target.Value = Format(Now(), "dd/mm/yyyy")    '<< change format to suit
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    Dim LRow As Long
    LRow = Cells.Find("*", , xlFormulas, , 1, 2).Row
    If Not Intersect(Me.Range("A3:I" & LRow), Target) Is Nothing Then
        Application.EnableEvents = False
        With Me.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("G2"), Order:=xlAscending
            .SortFields.Add Key:=Range("A2"), Order:=xlAscending
            .SortFields.Add Key:=Range("F2"), Order:=xlAscending
            .SortFields.Add Key:=Range("E2"), Order:=xlAscending
            .SetRange Range("A3:I" & LRow)
            .Apply
        End With
    End If
    Application.EnableEvents = True
End Sub

If you want the data separated by the dates in column A, would you not be better changing the sort order in the above code to sorting column A first?

 

[kevin9999]

Give this a try:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Me.Range("G3", Cells(Rows.Count, "H").End(3)), Target) Is Nothing Then
        Cancel = True
        If Target.Column = 7 And Target.Value <> "Yes" Then Target.Value = "Yes"
        If Target.Column = 8 Then Target.Value = Format(Now(), "dd/mm/yyyy")    '<< change format to suit
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    Dim LRow As Long, i As Long
    LRow = Cells.Find("*", , xlFormulas, , 1, 2).Row
    If Not Intersect(Me.Range("A3:I" & LRow), Target) Is Nothing Then
        Application.EnableEvents = False
        With Me.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("A2"), Order:=xlAscending    '<< swap this line with..
            .SortFields.Add Key:=Range("G2"), Order:=xlAscending    '<< this one if you want sort as per original
            .SortFields.Add Key:=Range("F2"), Order:=xlAscending
            .SortFields.Add Key:=Range("E2"), Order:=xlAscending
            .SetRange Range("A3:I" & LRow)
            .Apply
        End With
    End If
    
    For i = LRow To 3 Step -1
        If Cells(i, 1) <> Cells(i - 1, 1) Then Cells(i, 1).EntireRow.Insert
    Next i
    Application.EnableEvents = True
End Sub