Consulting

Results 1 to 8 of 8

Thread: A Loop in a Loop

  1. #1

    A Loop in a Loop

    I am trying to loop through a single column (A) of data until I find a Blank cell .

    Inside that loop I am wanting to insert a new row when the value of the Active cell is Not equal to the value of the cell above it and then continue the first loop.

    Thanks

  2. #2
    Moderator VBAX Guru Simon Lloyd's Avatar
    Joined
    Sep 2005
    Location
    UK
    Posts
    3,003
    Location
    This should do what you want[VBA]Sub InsRow_UntilBlank()
    Dim Rng As Range, MyCell As Range
    Set Rng = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row + 1)
    For Each MyCell In Rng
    If MyCell.Value = "" Then Exit Sub
    If MyCell.Value <> MyCell.Offset(-1, 0).Value Then
    With Range(MyCell.Address)
    .Insert
    End With
    End If
    Next
    End Sub[/VBA]
    Regards,
    Simon
    Please read this before cross posting!
    In the unlikely event you didn't get your answer here try Microsoft Office Discussion @ The Code Cage
    If I have seen further it is by standing on the shoulders of giants.
    Isaac Newton, Letter to Robert Hooke, February 5, 1675 English mathematician & physicist (1642 - 1727)

  3. #3
    Thanks Simon...But this gives an infinite loop after finding the first non-matching cell...any idea why???

  4. #4
    Moderator VBAX Guru Simon Lloyd's Avatar
    Joined
    Sep 2005
    Location
    UK
    Posts
    3,003
    Location
    Ah! yes because it is inserting a blank row which is not equal value to the one above so performs the insert again!
    [VBA]
    Sub InsRow_UntilBlank()
    Dim Rng As Range, MyCell As Range
    Set Rng = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row + 1)
    For Each MyCell In Rng
    If MyCell.Value = "" Then GoTo Nxt
    If MyCell.Value <> MyCell.Offset(-1, 0).Value Then
    With Range(MyCell.Address)
    .Insert
    End With
    End If
    Nxt:
    Next
    End Sub
    [/VBA]try this untested!
    Regards,
    Simon
    Please read this before cross posting!
    In the unlikely event you didn't get your answer here try Microsoft Office Discussion @ The Code Cage
    If I have seen further it is by standing on the shoulders of giants.
    Isaac Newton, Letter to Robert Hooke, February 5, 1675 English mathematician & physicist (1642 - 1727)

  5. #5
    Thanks....Same inifinite loop...It is inserting cells instead of rows and goes into Loop d' Loop

  6. #6
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,147
    Location
    [vba]

    Sub InsRow_UntilBlank()
    Dim LastRow As Long
    Dim i As Long

    With ActiveSheet

    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = LastRow To 2 Step -1

    If .Cells(i, "A").Value <> .Cells(i - 1, "A").Value Then

    .Rows(i).Insert
    End If
    Next
    End With
    End Sub
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  7. #7
    Perfect!!! Thanks

  8. #8
    Moderator VBAX Guru Simon Lloyd's Avatar
    Joined
    Sep 2005
    Location
    UK
    Posts
    3,003
    Location
    My apologies, for a couple of things, 1 i didn't test either of my offerings and 2 as xld will no doubt bend my ear on later, i didn't design the code to perform from the last row up, performing the action from row 1 down is prone to giving false results.
    Regards,
    Simon
    Please read this before cross posting!
    In the unlikely event you didn't get your answer here try Microsoft Office Discussion @ The Code Cage
    If I have seen further it is by standing on the shoulders of giants.
    Isaac Newton, Letter to Robert Hooke, February 5, 1675 English mathematician & physicist (1642 - 1727)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •