Help with infinite loop please

[M_S_Jones]

Hello all,

I have built a macro which formats a sheet of data to meet a specification. It works fine, but I have recently encountered the need to format some data differently. I was hoping to keep my old macro and then build another that could be run afterwards to add some final formatting if desired. Basically I want records to be grouped if groups exist. The data has two levels of customers in each row. In the event that two or more rows consecutively have the same higher level of customer, I want to insert a blank row above the first, and another blank row below the last.

Here is my code to add a blank row below the last:

Sub NEWTEST()
Dim rnArea As Range
Dim rnCell As Range


Set rnArea = Range("C8:C1000")

For Each rnCell In rnArea
     With rnCell
          If rnCell.Text = rnCell.Offset(-1).Text And rnCell.Text <> rnCell.Offset(1).Text Then
            rnCell.Select
            ActiveCell.Offset(1).EntireRow.Insert
          End If
    End With
Next
End Sub

Now this works exactly as desired. However, it is adding the blank row above the first that is proving to be a struggle for me. I've tried the opposite of the above if statement:

ElseIf rnCell.Text <> rnCell.Offset(-1, 0).Text And rnCell.Text = rnCell.Offset(1, 0).Text Then
       rnCell.EntireRow.Insert shift:=xlDown

Which results in an infinite loop as the new row above shifts the row with focus down one, then the next row to be evaluated becomes the row that has just been moved, which is still the same as the row below it, and so another row is inserted and then the same row evaluated again, and so on.

Is there a way to move to the next cell plus one? I was thinking that perhaps I could create a new variable that the first part of my if statement could set to one value and the 'elseif' part could set to another. Then I could put an if statement around the 'Next' command that says if the variable equals the first value then 'Next', elseif it equals the second, move to 'Next + 1'. Or something like that. Is it possible? If not, then what can I do? It doesn't need to be fancy, it just needs to work!

Thanks,

Matthew

 

[namliam]

ActiveCell.Cells(2, 1).Select will move your "activecell" one down.

Good Luck.

 

[M_S_Jones]

ActiveCell.Cells(2, 1).Select will move your "activecell" one down.

Thanks Mailman, but where exactly should I put that? I've already managed to navigate my way around the sheet for comparisons using offsets. I've added your code before the next command, assuming that's what you meant, but it doesn't change anything, adding a new row above the cell currently being evaluated still means that the next cell is the one that was just evaluated and thus it's still an infinite loop.

The code post-modification looked like this:

Sub NEWTEST()
Dim rnArea As Range
Dim rnCell As Range

Set rnArea = Range("C8:C1000")

For Each rnCell In rnArea
     With rnCell
        If rnCell.Text = rnCell.Offset(-1).Text And rnCell.Text <> rnCell.Offset(1).Text Then
            rnCell.Select
            ActiveCell.Offset(1).EntireRow.Insert
        ElseIf rnCell.Text <> rnCell.Offset(-1, 0).Text And rnCell.Text = rnCell.Offset(1, 0).Text Then
            rnCell.EntireRow.Insert shift:=xlDown
        End If
    End With
[B]ActiveCell.Cells(2, 1).Select[/B]
Next
End Sub

Thanks,

Matthew

 

[M_S_Jones]

Any other suggestions still welcome!

Matthew

 

[namliam]

I just glanced your problem and didnt see the "move down" part, thought that was missing.

Your problem thought is different. You are checking for differences both up and down... You should only check one way....
This will work:

Dim rnArea As Range
Dim rnCell As Range

Set rnArea = Range("C8:C1000")

For Each rnCell In rnArea
    With rnCell
        If rnCell.Text = rnCell.Offset(-1).Text And rnCell.Text <> rnCell.Offset(1).Text Then
            rnCell.Select
            ActiveCell.Offset(1).EntireRow.Insert
'        ElseIf rnCell.Text <> rnCell.Offset(-1, 0).Text And rnCell.Text = rnCell.Offset(1, 0).Text Then
'            rnCell.EntireRow.Insert shift:=xlDown
        End If
    End With

 

[M_S_Jones]

Hi Mailman,

Yes that's the code that I posted in my first message that I said works fine. It adds a row below the group. My problem is that I also need to add a row above the group.

For example

Customer 1
Customer 2
Customer 3
Customer 3
Customer 3
Customer 4
Customer 5

Should become:

Customer 1
Customer 2

Customer 3
Customer 3
Customer 3

Customer 4
Customer 5

However, using this code it becomes:

Customer 1
Customer 2
Customer 3
Customer 3
Customer 3

Customer 4
Customer 5

Can you see my problem now? If I add a row above the first 'Customer 3' then that row is shifted down. When the code gets to the 'Next' part, it moves to the first 'Customer 3' once again, adds a row above, shifts it down and then moves to the same row again. This is my loop that I am trying to get out of. That's why I asked if there was a way to conditionally move to Next + 1 so that I would get out of that loop whenever a row is added above. I appreciate that I am effectively trying to work both up and down at the same time; failing the Next + 1 idea, is there a way to iterate up the rows? I tried changing the range so that rather than C8:1000 it read C1000:C8, but it still iterated down.

Thanks,

Matthew

 

[namliam]

In which case you 'simply' have to make sure you are not checking against a blank value, like so:

Dim rnArea As Range
Dim rnCell As Range

Set rnArea = Range("C8:C1000")

For Each rnCell In rnArea
    With rnCell
        Debug.Print rnCell.Text, rnCell.Offset(-1).Text, rnCell.Offset(1).Text
        If rnCell.Text = rnCell.Offset(-1).Text _
       And rnCell.Text <> rnCell.Offset(1).Text Then
            rnCell.Select
            ActiveCell.Offset(1).EntireRow.Insert
        ElseIf [B][U]rnCell.Offset(-1) <> "" [/U][/B]_
           And rnCell.Text <> rnCell.Offset(-1).Text _
           And rnCell.Text = rnCell.Offset(1).Text Then
            rnCell.EntireRow.Insert shift:=xlDown
        End If
    End With
Next rnCell

 

[M_S_Jones]

Ahh... I think I have it. This seems to be a simple solution that works, I've added a line that simply marks the record above the first entry of the customer group:

Sub NEWTEST2()
Dim rnArea As Range
Dim rnCell As Range

Set rnArea = Range("C8:C1000")

For Each rnCell In rnArea
     With rnCell
        If rnCell.Text = rnCell.Offset(-1).Text And rnCell.Text <> rnCell.Offset(1).Text Then
            rnCell.Select
            ActiveCell.Offset(1).EntireRow.Insert
        ElseIf rnCell.Text <> rnCell.Offset(-1, 0).Text And rnCell.Text = rnCell.Offset(1, 0).Text Then
            [B]rnCell.Offset(-1, 10).Value = "A"[/B]
        End If
    End With
Next
End Sub

And then written another macro to iterate through, find the record that is marked and insert a row below it:

Sub NEWTEST3()
Dim rnArea As Range
Dim rnCell As Range

Set rnArea = Range("M8:M1000")

For Each rnCell In rnArea
     With rnCell
        If rnCell.Value = "A" Then
            rnCell.Select
            ActiveCell.Offset(1).EntireRow.Insert
        End If
    End With
Next
End Sub

After some very basic testing this seems to work. It might be a dirty hack, but it does the job. Thanks anyway Mailman.

Matthew

 

[M_S_Jones]

Hi Mailman,

Yes that works too, thanks. It's a bit more concise than mine too

Thanks for your help.

Matthew

 

[namliam]

And another delivery

Happy to have helped have a good weekend (soon)

 

[M_S_Jones]

Happy to have helped have a good weekend (soon)

And you too my friend.

Matthew