Help with For-Next loop

[lopiteaux]

Hi all - I've got a bit of code and it's all working neatly, but there is one little bit that's escaping me...

Sub Component_UpdateRiskStatus()


    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    If IsEmpty(Range("A3")) Then
        Exit Sub
    Else
        GoTo UpdateRiskStatus
    End If
    
UpdateRiskStatus:
    checksheet = ActiveSheet.Name
    counter = 0
        
    Range("A3").End(xlDown).Select
        lr = ActiveCell.Row
    
    For n = 3 To lr
        
        checkmsg = "Now checking row #" & n & " out of " & lr & "." 'REMOVE.
        checkmsg = checkmsg & vbNewLine & vbNewLine & "n: " & n
        checkmsg = checkmsg & vbNewLine & vbNewLine & "lr: " & lr
        checkmsg = checkmsg & vbNewLine & vbNewLine & "counter: " & counter
        checkans = MsgBox(checkmsg, vbOKOnly)
        
        x = Application.VLookup(Cells(n, "C"), Sheets("All Agreements").Columns("C:E"), 3, False)
        If Not (IsError(x)) Then
            If Not IsEmpty(Application.VLookup(Cells(n, "C"), Sheets("All Agreements").Columns("C:E"), 3, False)) Then
                y = WorksheetFunction.Match(Cells(n, "C"), Sheets("Credit Watch").Columns("C:C"), 0)
                Range("$I" & n & ":$AX" & n).Copy
                Sheets("Credit Watch").Select
                    Range("$I" & y).Select
                        ActiveSheet.Paste
                Range("A1").Select
                Sheets(checksheet).Select
                Range(n & ":" & n).Select
                    Selection.Delete
                n = n - 1
                lr = lr - 1
                counter = counter + 1
            Else
            End If
        Else
            Cells(n, "C").Select
                With Selection.Interior
                    .ColorIndex = 6
                    .Pattern = xlSolid
                End With
        End If
    Next n
    
    MsgBox "All " & checksheet & " agreements have been checked. " & counter & " agreements have been updated on the Credit Watch list."
    
End Sub

In short, the code goes through a list of agreements and updates them on a worksheet called "Credit Watch" if the risk status has been updated on the worksheet "All Agreements". That's all working beautifully.

The problem comes in towards the end, when I delete the rows that are due for update on "Credit Watch" - I've put in the following line:

    n = n - 1
                lr = lr - 1

In the hope that it (a) doesn't skip an agreement due to it moving up in the list (n = n - 1), which is working great, and also (b) that the check ends earlier as the list is shortened (lr = lr - 1). The first bit is working, but it seems that lr - 1 is not... I'm assuming that this is because I am specifying the lr at the beginning of the code.

Any thoughts?

l.

 

[VoG]

Try looping backwards

Sub Component_UpdateRiskStatus()


    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    If IsEmpty(Range("A3")) Then
        Exit Sub
    Else
        GoTo UpdateRiskStatus
    End If
    
UpdateRiskStatus:
    checksheet = ActiveSheet.Name
    counter = 0
        
        LR = Range("A" & Rows.Count).End(xlUp).Row

    
    For n = LR To 3 Step -1
        
        checkmsg = "Now checking row #" & n & " out of " & LR & "." 'REMOVE.
        checkmsg = checkmsg & vbNewLine & vbNewLine & "n: " & n
        checkmsg = checkmsg & vbNewLine & vbNewLine & "lr: " & LR
        checkmsg = checkmsg & vbNewLine & vbNewLine & "counter: " & counter
        checkans = MsgBox(checkmsg, vbOKOnly)
        
        x = Application.VLookup(Cells(n, "C"), Sheets("All Agreements").Columns("C:E"), 3, False)
        If Not (IsError(x)) Then
            If Not IsEmpty(Application.VLookup(Cells(n, "C"), Sheets("All Agreements").Columns("C:E"), 3, False)) Then
                y = WorksheetFunction.Match(Cells(n, "C"), Sheets("Credit Watch").Columns("C:C"), 0)
                Range("$I" & n & ":$AX" & n).Copy
                Sheets("Credit Watch").Range("$I" & y).Paste
                Rows(n).Delete
                counter = counter + 1
            Else
            End If
        Else
            Cells(n, "C").Interior.ColorIndex = 6
        End If
    Next n
    
    MsgBox "All " & checksheet & " agreements have been checked. " & counter & " agreements have been updated on the Credit Watch list."
    
End Sub

 

[Norie]

So you want to delete the rows that are getting moved?

How about moving everything first and then deleting after that's done.

If you try and do both at the same time then it's going to cause problems, eg rows will be moved.

One thing you definitely don't want to do is change the loop variables N and LR in the loop.

This code is untested but it might give you some ideas.

Option Explicit
Sub Component_UpdateRiskStatus()
Dim wsCheck As Worksheet
Dim rngDelete As Range
Dim CheckMsg As String
Dim counter As Long
Dim LR As Long
Dim N As Long
Dim X
Dim Y
Dim checkans
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    If IsEmpty(Range("A3")) Then
        Exit Sub
    End If

    Set wsCheck = ActiveSheet
    counter = 0
    LR = wsCheck.Range("A" & Rows.Count).End(xlUp).Row
    For N = 3 To LR
        CheckMsg = "Now checking row #" & N & " out of " & LR & "."    'REMOVE.
        CheckMsg = CheckMsg & vbNewLine & vbNewLine & "n: " & N
        CheckMsg = CheckMsg & vbNewLine & vbNewLine & "lr: " & LR
        CheckMsg = CheckMsg & vbNewLine & vbNewLine & "counter: " & counter
        checkans = MsgBox(CheckMsg, vbOKOnly)
        X = Application.VLookup(wsCheck.Cells(N, "C"), Sheets("All Agreements").Columns("C:E"), 3, False)
        If Not (IsError(X)) Then

            If Not IsEmpty(Application.VLookup(wsCheck.Cells(N, "C"), Sheets("All Agreements").Columns("C:E"), 3, False)) Then

                Y = WorksheetFunction.Match(wsCheck.Cells(N, "C"), Sheets("Credit Watch").Columns("C:C"), 0)

                wsCheck.Range("$I" & N & ":$AX" & N).Copy Sheets("Credit Watch").Range("$I" & Y)
 
                ' add row to delete to rngDelete
                If rngDelete Is Nothing Then
 
                    Set rngDelete = wsCheck.Range(N & ":" & N)
                Else
                    Set rngDelete = Union(rngDelete, wsCheck.Range(N & ":" & N))
                End If
 
            Else
 
                With wsCheck.Cells(N, "C").Interior
                    .ColorIndex = 6
                    .Pattern = xlSolid
                End With

            End If
        End If
 
    Next N
 
    ' delete all agreements that have been moved
    rngDelete.EntireRow.Delete xlShiftUp
 
    MsgBox "All " & wsCheck.Name & " agreements have been checked. " & rngDelete.Rows.Count & " agreements have been updated on the Credit Watch list."
 
End Sub

 

[lopiteaux]

Thanks VoG - I would have never thought of it, but the answer is beautiful in it's simplicity.

I've tested it on a sample population and it works perfectly, thank you.

A quick question though... I see you've shortened my code in some places (can't say I blame you!) - strangely enough, when I shorten

Sheets("Credit Watch").Select
    Range("$I" & y).Select
        ActiveSheet.Paste

to

Sheets("Credit Watch").Range("$I" & y).Paste

I get a "Run-time error '438'", "Object doesn't support this type of property or method". Do you know why this is?

l.

Try looping backwards

Sub Component_UpdateRiskStatus()
 
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    If IsEmpty(Range("A3")) Then
        Exit Sub
    Else
        GoTo UpdateRiskStatus
    End If
 
UpdateRiskStatus:
    checksheet = ActiveSheet.Name
    counter = 0
 
        LR = Range("A" & Rows.Count).End(xlUp).Row
 
 
    For n = LR To 3 Step -1
 
        checkmsg = "Now checking row #" & n & " out of " & LR & "." 'REMOVE.
        checkmsg = checkmsg & vbNewLine & vbNewLine & "n: " & n
        checkmsg = checkmsg & vbNewLine & vbNewLine & "lr: " & LR
        checkmsg = checkmsg & vbNewLine & vbNewLine & "counter: " & counter
        checkans = MsgBox(checkmsg, vbOKOnly)
 
        x = Application.VLookup(Cells(n, "C"), Sheets("All Agreements").Columns("C:E"), 3, False)
        If Not (IsError(x)) Then
            If Not IsEmpty(Application.VLookup(Cells(n, "C"), Sheets("All Agreements").Columns("C:E"), 3, False)) Then
                y = WorksheetFunction.Match(Cells(n, "C"), Sheets("Credit Watch").Columns("C:C"), 0)
                Range("$I" & n & ":$AX" & n).Copy
                Sheets("Credit Watch").Range("$I" & y).Paste
                Rows(n).Delete
                counter = counter + 1
            Else
            End If
        Else
            Cells(n, "C").Interior.ColorIndex = 6
        End If
    Next n
 
    MsgBox "All " & checksheet & " agreements have been checked. " & counter & " agreements have been updated on the Credit Watch list."
 
End Sub

 

[VoG]

That was me trying to be clever without thinking. Try

Sheets("Credit Watch").Range("$I" & y).PasteSpecial Paste:=xlPasteAll

 

[lopiteaux]

legend. thanks for your help buddy!

That was me trying to be clever without thinking. Try

Sheets("Credit Watch").Range("$I" & y).PasteSpecial Paste:=xlPasteAll