Results 1 to 4 of 4

Need help stepping backward in a loop

This is a discussion on Need help stepping backward in a loop within the Excel Questions forums, part of the Question Forums category; It's been a long time since I've written macros and I guess I have gotten (extremely) rusty. I have a ...

  1. #1
    New Member
    Join Date
    Oct 2013
    Posts
    3

    Default Need help stepping backward in a loop

    It's been a long time since I've written macros and I guess I have gotten (extremely) rusty. I have a workbook with some data and I want to move all lines with a particular error code onto another worksheet called "Do Not Work"

    I have 2 problems.
    1) I have pieced together the below code and it only moves some of the lines with the error code. Prior to adding in the code to create a new worksheet if the macro was executed about 5 times everything would eventually move.I know it's a problem with the loop and needing to step backwards but I can't figure out how to implement in this code.

    2) Right now my code is explicitly written to move data from "Sheet1". The reality is the sheet with the data that needs to be moved will always be called something different but will always be the 1st worksheet. Is there a way to address this?

    Thanks for any help!

    Sub BillRunErr_27807()

    Dim Newsheet
    Set Newsheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
    Newsheet.Name = "DO NOT WORK"

    Application.ScreenUpdating = False

    Sheets("Sheet1").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("DO NOT WORK").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select

    Dim xRg As Range
    Dim xCell As Range
    Dim i As Long
    Dim J As Long
    i = Sheets("Sheet1").UsedRange.Rows.Count
    J = Sheets("DO NOT WORK").UsedRange.Rows.Count

    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("DO NOT WORK").UsedRange) = 0 Then J = 0
    End If

    Set xRg = Worksheets("Sheet1").Range("A1:A" & i)
    For Each xCell In xRg
    If CStr(xCell.Value) Like "*YMM27807*" Then
    xCell.EntireRow.Copy Destination:=Worksheets("DO NOT WORK").Range("A" & J + 1)
    xCell.EntireRow.Delete
    J = J + 1
    End If
    Next
    Application.ScreenUpdating = True
    End Sub

  2. #2
    MrExcel MVP Eric W's Avatar
    Join Date
    Aug 2015
    Location
    Bountiful, UT
    Posts
    4,368

    Default Re: Need help stepping backward in a loop

    Try this on a copy of your workbook:

    Code:
    Sub BillRunErr_27807()
    Dim NewSheet As Worksheet, CopyRange As Range, MyRange As Variant, i As Long
    
        Application.ScreenUpdating = False
            
        Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
        NewSheet.Name = "DO NOT WORK"
    
        Sheets(1).Select
        Range("A1:F1").Copy NewSheet.Range("A1:F1")
    
        MyRange = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
    
        For i = 2 To UBound(MyRange)
            If MyRange(i, 1) Like "*YMM27807*" Then
                If CopyRange Is Nothing Then
                    Set CopyRange = Cells(i, 1)
                Else
                    Set CopyRange = Union(CopyRange, Cells(i, 1))
                End If
            End If
        Next i
    
        CopyRange.EntireRow.Copy NewSheet.Rows(2)
        CopyRange.EntireRow.Delete
        
        Application.ScreenUpdating = True
    
    End Sub
    The line in red should select the first sheet. In the line below it, change the ranges to be the number of headings you want to copy.

    Let me know how this works.
    Cheers,
    Eric

    When you eliminate the impossible, whatever remains, however improbable, must be the truth.

    -Posting guidelines, forum rules, terms of use, FAQs, BB codes, See how to search the forum
    -Post a screen shot with the HTML Maker

  3. #3
    New Member
    Join Date
    Oct 2013
    Posts
    3

    Default Re: Need help stepping backward in a loop

    It doesn't like sheets(1).select

    I get Run time error 1004: select method of worksheet class failed.

    Any other ideas to address a changing worksheet name?
    If I change the 1 to the actual sheet name it works wonderfully. Your solution is much more elegant than I was trying to do!


    Quote Originally Posted by Eric W View Post
    Try this on a copy of your workbook:

    Code:
    Sub BillRunErr_27807()
    Dim NewSheet As Worksheet, CopyRange As Range, MyRange As Variant, i As Long
    
        Application.ScreenUpdating = False
            
        Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
        NewSheet.Name = "DO NOT WORK"
    
        Sheets(1).Select
        Range("A1:F1").Copy NewSheet.Range("A1:F1")
    
        MyRange = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
    
        For i = 2 To UBound(MyRange)
            If MyRange(i, 1) Like "*YMM27807*" Then
                If CopyRange Is Nothing Then
                    Set CopyRange = Cells(i, 1)
                Else
                    Set CopyRange = Union(CopyRange, Cells(i, 1))
                End If
            End If
        Next i
    
        CopyRange.EntireRow.Copy NewSheet.Rows(2)
        CopyRange.EntireRow.Delete
        
        Application.ScreenUpdating = True
    
    End Sub
    The line in red should select the first sheet. In the line below it, change the ranges to be the number of headings you want to copy.

    Let me know how this works.

  4. #4
    MrExcel MVP Eric W's Avatar
    Join Date
    Aug 2015
    Location
    Bountiful, UT
    Posts
    4,368

    Default Re: Need help stepping backward in a loop

    I don't know what to tell you about the

    Code:
        Sheets(1).Select
    line. It should select the first sheet of the workbook. I haven't been able to duplicate your error. You could try

    Code:
    Worksheets(1).Select
    or

    Code:
        For Each sh In Worksheets
            Sheets(sh.Name).Select
            Exit For
        Next sh
    but frankly, those probably won't work either. They might give you some information though. Let us know if you figure something out.
    Cheers,
    Eric

    When you eliminate the impossible, whatever remains, however improbable, must be the truth.

    -Posting guidelines, forum rules, terms of use, FAQs, BB codes, See how to search the forum
    -Post a screen shot with the HTML Maker

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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


DMCA.com