[cristobal03]

Sub InsertRowsAtSets()
  Dim Rng As Range
  Dim lngCurRow As Long
  Dim lngCounter As Long

  Set Rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)

  For lngCurRow = 1 To Rng.Rows.Count
    If Rng.Cells(lngCurRow, 1).Value = Rng.Cells(lngCurRow, 1).Offset(1, 0).Value Then
      lngCounter = 1
      Do While Rng.Cells(lngCurRow, 1).Value = Rng.Cells(lngCurRow, 1).Offset(lngCounter, 0).Value
        lngCounter = lngCounter + 1
      Loop
      lngCurRow = lngCurRow + lngCounter
      Rng.Cells(lngCurRow, 1).EntireRow.Insert Shift:=xlDown
    End If
  Next lngCurRow
End Sub

Kind of a mix of everybody's suggestions...I haven't tested, so I don't know if that'll work like I expect it to.

HTH, post back if it inserts a row only after a set of numbers, or if it doesn't work at all too, I guess...

chris.

[edit]
Just tested and it worked great for me. Produced output:

1
2
2
2
2
new row
3
4
4
4
4
new row
5
6
7
7
7
new row
8
8
8
new row
9
9

If that's more like what you wanted.
[/edit]

[Glaswegian]

Chris

Had a quick look. I may be wrong here, but the original row count will count the number of rows in the range - OK. However, once you start to insert rows from the top, the range becomes extended because of the extra rows. So the code will not insert rows after a certain point. So if you have 25 rows to start, and you insert five rows in, say the first twenty rows, the total number of rows now becomes 30. the last five rows will have moved beyond the original count and will therefore be missed. Does that make sense? I'm not here to criticise BTW - just my take on a first look at your code.

I don't have time just now to test or confirm this - I'll maybe get a chance later tonight. Or else Zack will pop in and tell me I'm talking rubbish!

[cristobal03]

Is that why you did yours backwards? I couldn't figure out why you did that. It makes sense though.

Still, I didn't see that behavior...If that was the case, in the test sample I posted (#15), a new row wouldn't have been inserted after the eights because they would've fallen outside the adjusted range. I'll do some more testing.

Thanks for the spot.

chris.

[cristobal03]

[bump]

You are indeed correct, Glaswegian. Testing 1050 values, no new rows were inserted after row 1050. Let me modify my code a little.

chris.

[cristobal03]

Well, I know this isn't a great way to do it, but I'm too tired to figure out the logic to do it in reverse, so I just opened up the range entirely and added a conditional for empty cells. Running 1050 values took a couple seconds. Here's the code:

Public Sub InsertRowAtSet()

' Written for TSG user Dreambringer; inserts a blank row
' after a set of numbers in column A (skips rows that
' have distinct/unique values in column A).

  Dim Rng As Range
  Dim lngCurRow As Long
  Dim lngCounter As Long

  Application.ScreenUpdating = False

  Set Rng = Range("A1:A" & Cells(Rows.Count, "A").Row)

  For lngCurRow = 1 To Rng.Rows.Count
    If Rng.Cells(lngCurRow, 1).Value <> "" Then
      If Rng.Cells(lngCurRow, 1).Value = Rng.Cells(lngCurRow, 1).Offset(1, 0).Value Then
        lngCounter = 1
        Do While Rng.Cells(lngCurRow, 1).Value = Rng.Cells(lngCurRow, 1).Offset(lngCounter, 0).Value
          lngCounter = lngCounter + 1
        Loop
        lngCurRow = lngCurRow + lngCounter
        Rng.Cells(lngCurRow, 1).EntireRow.Insert Shift:=xlDown
      End If
    End If
  Next lngCurRow

  Application.ScreenUpdating = True

End Sub

If someone wants to figure out the logic to do it in reverse, feel free. I have a feeling it might be as simple as swapping these two lines (in the algorithm, I mean; of course code would have to be changed to decrement):

lngCurRow = lngCurRow + lngCounter
Rng.Cells(lngCurRow, 1).EntireRow.Insert Shift:=xlDown

chris.

[Dreambringer]

This is why I love this place, so many options, and I learn so much.. I am going to be running through all of these, and see which one helps the most, thanx again guys for all your suggestions...

[cristobal03]

Just for giggles. I got the decrement method to work. I was missing a + 1 in my code. I hate little things like that.

Public Sub InsertRowAtSet()

' Written for TSG user Dreambringer; inserts a blank row
' after a set of numbers in column A (skips rows that
' have distinct/unique values in column A).

  Dim Rng As Range
  Dim lngCurRow As Long
  Dim lngCounter As Long

  Application.ScreenUpdating = False

  Set Rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)

  For lngCurRow = Rng.Rows.Count To 2 Step -1
    If Rng.Cells(lngCurRow, 1).Value = Rng.Cells(lngCurRow, 1).Offset(-1, 0).Value Then
      Rng.Cells(lngCurRow, 1).Offset(1, 0).EntireRow.Insert Shift:=xlDown
      lngCounter = -1
      Do While Rng.Cells(lngCurRow, 1).Value = Rng.Cells(lngCurRow, 1).Offset(lngCounter, 0).Value
        lngCounter = lngCounter - 1
      Loop
      ' I have no idea why I had to add the + 1 to get this to work.
      lngCurRow = lngCurRow + lngCounter + 1
    End If
  Next lngCurRow

  Application.ScreenUpdating = True

End Sub

As you can see, I can't quite figure out why I needed the + 1, but I tossed it in instinctively after using some Debug.Prints to list the row numbers, so I guess it had something to do with that.

Anyway, just so's you have another option.

chris.

[Zack Barresse]

Wow, miss a day, miss everything.

So if I weren't late, I'd say, "Yup, you need to iterate through the range backwards. You do this when Inserting/Deleting/Cutting any range associated with your [parent] range." But I'm too late. LOL!

Hope I didn't come across wrong to anybody here. Glas, I've always been a fan of your work.

[Glaswegian]

Originally Posted by cristobal03

Is that why you did yours backwards? I couldn't figure out why you did that. It makes sense though.

Still, I didn't see that behavior...If that was the case, in the test sample I posted (#15), a new row wouldn't have been inserted after the eights because they would've fallen outside the adjusted range. I'll do some more testing.

Thanks for the spot.

chris.

Hi Chris

Sorry I didn't get a chance to get back to you sooner. However, I see you've solved it . And you were right, working from the bottom of the range up for adding/deleting rows is always safer. I normally do the same as you did - count the rows with data to give a starting point and work from there. I don't know if my quickly garbled explanation was clear, but the same idea works for deleting rows.

Regards

[Glaswegian]

Originally Posted by firefytr

Wow, miss a day, miss everything.

So if I weren't late, I'd say, "Yup, you need to iterate through the range backwards. You do this when Inserting/Deleting/Cutting any range associated with your [parent] range." But I'm too late. LOL!

Hope I didn't come across wrong to anybody here. Glas, I've always been a fan of your work.

Zack, I was leaving this fight to you and Andy (Bomb) but Chris has beaten us all.

[Dreambringer]

Works like a champ cris!

Now for grins, would you mind breaking down the code just so I know what im looking at? if its too much trouble dont worry about it, but thats exacly what I was looking for!

[cristobal03]

No problems, glad I could help

I've commented the code I posted. Just to be clear, when I speak of a preceding row in my comments, I mean the row above the active row, not the row that came before. I hope that makes sense. If anyone else wants to add to my comments, please feel free. I don't have a great understanding of Excel and its objects.

Public Sub InsertRowAtSet()

' Written for TSG user Dreambringer; inserts a blank row
' after a set of numbers in column A (skips rows that
' have distinct/unique values in column A).

  ' I'll take for granted the variable declarations are
  ' pretty self-explanatory.  I use lngCurRow to keep
  ' track of the row I'm on, and lngCounter to increment
  ' (or, in this case, decrement) through sets of identical
  ' numbers.
  Dim Rng As Range
  Dim lngCurRow As Long
  Dim lngCounter As Long

  ' This isn't necessary but saves a lot of processor.
  Application.ScreenUpdating = False

  ' Based on Zack's (firefytr) forward-compatibility model; sets
  ' the working range to the used cells in column A by grabbing
  ' the whole column (A1:A65536) and moving up once, which moves
  ' to the first populated cell from the bottom of the sheet.
  Set Rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)

  ' We set the current row lngCurRow to the last row in the range,
  ' which has the same row number as the count of all rows in the range.
  ' We're decrementing by 1 (or incrementing by -1) until row 2.  If
  ' we went to row 1, it would throw an error at row 1, because there's
  ' no row 0.
  For lngCurRow = Rng.Rows.Count To 2 Step -1
    ' If the Value of the Cell in column 1 of the current row =
    ' the Value of the Cell in column 1 of the current row offset -1
    ' (think: the cell immediately above), then we know we've hit a set of
    ' identical numbers.
    If Rng.Cells(lngCurRow, 1).Value = Rng.Cells(lngCurRow, 1).Offset(-1, 0).Value Then
      ' First, insert a row below the current row.  It has to be below
      ' the current row because the current row represents the last row
      ' of the set of identical numbers.  This is because the current row's
      ' value is equal to the value of the row above it.
      Rng.Cells(lngCurRow, 1).Offset(1, 0).EntireRow.Insert Shift:=xlDown
      lngCounter = -1
      ' lngCounter, our decrement counter, manages the offsets.  This
      ' Do While...Loop compares the current row's value to preceding rows
      ' without changing the current row.  As soon as the loop hits a
      ' preceding row that is not equal to the current row, it stops.
      ' That way, our counter lngCounter tells us how many rows are in the
      ' set of identical numbers.
      Do While Rng.Cells(lngCurRow, 1).Value = Rng.Cells(lngCurRow, 1).Offset(lngCounter, 0).Value
        lngCounter = lngCounter - 1
      Loop
      ' I have no idea why I had to add the + 1 to get this to work.
      ' And I still don't, though I imagine it has something to do with the
      ' fact that we inserted a row.  It may seem odd that we're adding
      ' lngCurRow and lngCounter since we're decrementing, but remember
      ' lngCounter is a negative number, so we're actually subtracting.
      ' The point is, we're changing the current row to the current row
      ' minus the number of rows in the set of identical numbers.
      lngCurRow = lngCurRow + lngCounter + 1
    End If
    ' If the current row's value does not match the preceding row's value,
    ' the For...Next loop iterates to the preceding row (remember, Step -1).
  Next lngCurRow

  ' Now we get to see the results.
  Application.ScreenUpdating = True
End Sub

It'd probably help to copy/paste into a code editor so the comments appear green. Anyway, glad I could help.

chris.

[Dreambringer]

Thanx, pretty easy once I see what it all means!

Is there some place that I can look at hat tells me a list of the commands/defs ie.

Rng
lngCurRow
LngCounter

I know you broke it down for me, but was looking for a list somewhere

[cristobal03]

You can mark this thread Solved using the Thread Tools at the top of the page, if you're satisfied.

chris.

[Dreambringer]

Did allready