Nested For Loop when condition is met

Question

i'm trying to write a code in VBA to copy a cell value based on two criteria.

I'm trying to write a VBA code that will copy case file numbers (= cell values) to another worksheet if they are not present anymore om the worksheet where the daily updated data of case numbers is pasted. I want to filter out those case numbers that I have reviewed in the past and have been deleted (not anymore in the exported data).

I've searched the forum and tried a couple of things, but I keep receiving a error: next without For. I'm still an novice and find a lot of information about this error, but I don't seem to comprehend how to solve my code.

I have two criteria that need to be meet before the cell value may be copied.

Criteria 1: the cell value doesn't exists anymore in the range off daily updated data => This is don't by an excel formula that generates a "1" or "0". If it generates a "1", this means it is missing and this is the first criteria to copy.

Criteria 2: The cell value to copy doesn't already exist in the sheet to copy to. I want to run the code every day and don't want to end up with the same value being copied again and again and again.

My code at the moment looks like this:

Dim shCD As Worksheet, shVD As Worksheet
Dim VDCell As Range
Dim lrwCD As Long, lrwI As Long
Dim foundTrue As Boolean
Dim i As Integer, j As Integer

Application.ScreenUpdating = False

    Set shCD = Sheets("Checked Dossiers")
    Set shVD = Sheets("Verdwenen Dossiers")
    Set VDCell = FreeCell(shVD.Range("A5"))

    lrwCD = shCD.Cells(shCD.Rows.Count, "B").End(xlUp).Row
    lrwVD = shVD.Cells(shVD.Rows.Count, "A").End(xlUp).Row

    foundTrue = False   'my on/off switch to copy or not copy the cell value
    
    For i = 2 To lrwCD  
       For j = 2 To lrwVD 

'checking criteria 1, if this is true set switch to true and check if cell value already exists on sheet shVD in the range (A2:lrwVD)
            If shCD.Cells(i, 1).Value = "1" Then   
            foundTrue = True  
                 If shCD.Cells(i, 2).Value = shVD.Cells(j, 1).Value Then
                    foundTrue = False    ' If the cell value already exist -> set switch to false
        Next j

'After comparing cell value to the range (A2:lrwCD) and the switch is still on True -> start the copy command
                If foundTrue = True Then
                    shCD.Cells(i, 2).Copy
                    VDCell.PasteSpecial Paste:=xlPasteValues
                    VDCell = VDCell.Offset(1, 0)
                foundTrue = False  'set switch back to off (false) to start loop for next i
    Next i
   
Application.ScreenUpdating = True

You're not ending your If-clauses. Unless an If-clause is on one line, you need to use `End If` (on a separate line) at the end of that if-clause. However, about your checking if it exists, you really don't need a nested for-loop. Check out [this answer from VBasic](https://stackoverflow.com/a/75627716/19353309) for a similar endeavor of adding the ones that are missing. (it checks in one go with Application.Worksheetfunction.Match if it's missing and adds the ones that are missing in one go so it's quite fast!) — Notus_Panda, Jul 25 '23 at 12:21

score 0 · Answer 1 · answered Jul 25 '23 at 12:22

0

The problem you're encountering is caused by incorrect usage of the For and Next keywords in your loops. You've got a Next j keyword inside the If statement which doesn't have corresponding For j in the same block, hence the error.

answered Jul 25 '23 at 12:22

Ben Koch

71
3

CDP1802 · Answer 2 · 2023-07-25T12:59:13.867

Use Application.Match to check if exists without looping. Note: this assumes your case numbers are strings, if they are numeric change to casenum As Long.

Sub process()

    Dim arVD, lastrow As Double, VDcell As Range
    Dim i As Long, n As Long, casenum As String
    
    ' existing case numbers
    With Sheets("Verdwenen Dossiers")
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set VDcell = .Cells(lastrow + 1, "A")
        arVD = .Range("A2:A" & lastrow)
    End With
    
    ' scan and copy
    With Sheets("Checked Dossiers")
        lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = 2 To lastrow
            ' missing from daily
            If .Cells(i, 1).Value = "1" Then
            
                ' not already copied
                casenum = .Cells(i, "B")
                If IsError(Application.Match(casenum, arVD, 0)) Then
                    VDcell = casenum
                    Set VDcell = VDcell.Offset(1, 0)
                    n = n + 1
                End If
            
            End If
        Next
    End With
    MsgBox n & " rows copied", vbInformation

End Sub

You can `.Match` 2 ranges against each other in one go in case you didn't know :) See the link in my comment underneath OP's post. — Notus_Panda, Jul 25 '23 at 13:18

Nested For Loop when condition is met

2 Answers2