Results 1 to 4 of 4
  1. #1
    4 Star Lounger
    Join Date
    Jan 2001
    Location
    Illinois
    Posts
    552
    Thanks
    0
    Thanked 1 Time in 1 Post

    Can't stop this loop (Excel xp)

    I have written this bad macro and i don't know how to loop through it to make it stop. The user formats the first "banner" denoted by ZZZ01. After they format the cells etc. they run the macro which will search/replace all the subsequent ones like the first one. I know this is clumsy so any suggestions on how to make it run better are greatly appreciated. The files are usually 2 or 3 thousand rows. Thanks you for the help. <img src=/S/confused.gif border=0 alt=confused width=15 height=20>

    Also, if i merge the rows contained within the replacestatement it won't carry forward this formatting to the rest of the rows and i don't know why.

  2. #2
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Can't stop this loop (Excel xp)

    I would do it this way:

    <pre>Sub insertbanner()
    Dim I As Long, lLastRow As Long
    Dim strRangeSelect As Variant, strReplaceStatement As Variant
    Application.ScreenUpdating = False
    lLastRow = ActiveSheet.Range("A65536").End(xlUp).Row
    strRangeSelect = InputBox("What are the row numbers of the correct banner" & Chr(10) & _
    "i.e. 7:14 for row 7 through 14")
    If strRangeSelect = "" Then Exit Sub
    strReplaceStatement = Trim(UCase(InputBox("Find this text, ZZZ01, and the" & Chr(10) _
    & " new banner will be inserted")))
    If strReplaceStatement = "" Then Exit Sub
    For I = lLastRow To 0 Step -1
    If Trim(UCase(ActiveSheet.Range("A1").Offset(I, 0))) = strReplaceStatement Then
    ActiveSheet.Range(strRangeSelect).Copy
    ActiveSheet.Range("A1").Offset(I, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    ActiveSheet.Range("A1").Offset(I, 0).EntireRow.Delete
    End If
    Next I
    ActiveSheet.Range("A1").Select
    MsgBox ("Banners are inserted")
    Application.ScreenUpdating = True
    End Sub
    </pre>

    Legare Coleman

  3. #3
    4 Star Lounger
    Join Date
    Jan 2001
    Location
    Illinois
    Posts
    552
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Can't stop this loop (Excel xp)

    ok, thank you once again. How can i prevent it from changing the first one back to the "unmerged" version. It goes from the last row up to the top and when it encounters the first one that i defined, ie 7:14, it selects the cells and unmerges the banner. Thank you for the help

  4. #4
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Can't stop this loop (Excel xp)

    Where do you want it to stop? Below the range that is intput in the InputBox (i.e. 7:14)? If so, the you could use:

    <pre>Sub insertbanner()
    Dim I As Long, lLastRow As Long, lStop As Long
    Dim strRangeSelect As Variant, strReplaceStatement As Variant
    Application.ScreenUpdating = False
    lLastRow = ActiveSheet.Range("A65536").End(xlUp).Row
    strRangeSelect = InputBox("What are the row numbers of the correct banner" & Chr(10) & _
    "i.e. 7:14 for row 7 through 14")
    If strRangeSelect = "" Then Exit Sub
    strReplaceStatement = Trim(UCase(InputBox("Find this text, ZZZ01, and the" & Chr(10) _
    & " new banner will be inserted")))
    If strReplaceStatement = "" Then Exit Sub
    lStop = ActiveSheet.Range(strRangeSelect).Row + ActiveSheet.Range(strRangeSelect).Rows.Count - 1
    For I = lLastRow To lStop Step -1
    If Trim(UCase(ActiveSheet.Range("A1").Offset(I, 0))) = strReplaceStatement Then
    ActiveSheet.Range(strRangeSelect).Copy
    ActiveSheet.Range("A1").Offset(I, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    ActiveSheet.Range("A1").Offset(I, 0).EntireRow.Delete
    End If
    Next I
    ActiveSheet.Range("A1").Select
    Application.ScreenUpdating = True
    MsgBox ("Banners are inserted")
    End Sub
    </pre>

    Legare Coleman

Posting Permissions

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