insert rows at change query

[robcarr]

Hi All,

I am using the code listed below to create a blank row between each change of data in a column, I have come across a snag with the coding, if there is only 1 instance in the column the coding does not enter a blank row either side of that instance, instead it keeps the instance with the next block change, is there away to sperate all the instances with a blank row including single occurrences. What I need this for is each change of data contains the login and logout times of agents, I need to then be able to put a formula in each blank row so I can calculate the total time spent logged in. If anyone can help with this it would be very much appreciated.

Here is the code currently used to insert blank row at each change.


Sub InsertRowAtEachChange()
Dim rRange As Range

Application.ScreenUpdating = False

'Ensure an entire Column is selected
If Selection.Cells.Count <> 65536 Then
MsgBox &quot;You must select an entire column&quot;, vbCritical
End
End If

On Error Resume Next
'Set a range variable to all data in selected column
Set rRange = Range(Selection.Cells(3, 1), _
Selection.Cells(65536, 1).End(xlUp))

'Add a column for formulas
With rRange
.EntireColumn.Insert
.Offset(0, -1).FormulaR1C1 = _
&quot;=IF(AND(NOT(ISNA(R[-1]C)),&quot; _
& &quot;R[-1]C[1]<>RC[1]),NA(),&quot;&quot;&quot;&quot&quot;

'Set variable to #N/A! cells
Set rRange = .Offset(0, -1).SpecialCells _
(xlCellTypeFormulas, xlErrors)
End With
'Add a row at each #N/A! error
rRange.EntireRow.Insert

'Reset variable for next formulas
Set rRange = _
Range(Selection.Cells(2, 1), _
Selection.Cells(65536, 1).End(xlUp))

'Add the formula to add NA()
rRange.FormulaR1C1 = _
&quot;=IF(OR(RC[1]=&quot;&quot;&quot;&quot;,R[-1]C[1]=&quot;&quot;&quot;&quot,&quot;&quot;&quot;&quot;,&quot; _
& &quot;IF(RC[1]<>R[-1]C[1],NA()))&quot;

On Error GoTo 0
Set rRange = Nothing

End Sub