CODEWITHSUNDEEP
vbaexcel
user1664305
user1664305

Reputation: 179

Nested For statement exit and continue

I am using 2 for statements, 1 nested within another. What I am having issues with is when I exit the second statement and return to the first one I am unable to have the second statement go to the next cell, instead it keeps repeating itself.

for example:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r&, c&, cel As Range
Dim r3&, c3&, cel3 As Range
Dim ri As Range
Dim CurrentSheet As String
Dim CurrentCell As String

CurrentSheet = ActiveSheet.Name

Application.ScreenUpdating = False

ActiveCell.Offset(-1, 0).Select
CurrentCell = ActiveCell.Address    
r = ActiveCell.Row

For c = 26 To 31
    Sheets(CurrentSheet).Select

    Set cel = Cells(r, c)
    cel.Select
    Selection.Copy

    Cells(Target.Row, "B").Select
    Set ri = ActiveCell
    Sheets("Checklist").Select

    'For c2 = 1 To 31            
        Sheets("Checklist").Cells.Find(What:=ri.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Select

        For c3 = 25 To 30
            Sheets("checklist").Select
            r3 = Selection.Row
            Set cel3 = Sheets("checklist").Cells(r3, c3)
            cel3.Select
            Selection.PasteSpecial xlPasteValues
            Sheets(CurrentSheet).Select
            'Range(CurrentCell).Select
            'ActiveCell.Offset(0, 1).Select
            'CurrentCell = ActiveCell.Address
            'Exit For
        Next                        
    'Next
Next

Range(CurrentCell).Select

Application.CutCopyMode = False
Application.ScreenUpdating = True   

End Sub

Keep in mind that is not my actual code but rather an example of how it is structured. Instead of looping through columns 5 - 9 it just keeps selecting column 5.

Essentially what I am trying to do with the code is when a cell is changed on Sheet1 I want it to loop through each cell in that row (predetermined number of columns) and copy the cell value to sheet2 (Checklist for purposes of the code) and paste in a corresponding cell. The code also looks up and an identifier on sheet1 to find the correct row in sheet2.

Here is a link to the example file Checklist Example

Upvotes: 1

Views: 95

Answers (2)

user3598756
user3598756

Reputation: 29421

may be you're after this

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim f As Range
    If Intersect(Target, Range("D3:I11")) Is Nothing Then Exit Sub '<--| exit if user changed any cell outside "assigments" ones

    With Worksheets("Checklist") '<--\ reference "Checklist" sheet
        Set f = .Columns(1).SpecialCells(xlCellTypeConstants).Find(What:=Cells(Target.Row, 2), LookIn:=xlValues, LookAt:=xlWhole) '<--| try finding "Emp #" from Assignments sheet changed cell row column B in referenced sheet ("i.e. "Checklist") column "A" cells not blank cells
        If f Is Nothing Then '<--| if "Emp #" match not found
            MsgBox "I couldn't find " & Cells(Target.Row, 2).Value & " in worksheet 'Checklist'"
        Else ' <-- if "Emp #" match found
            .Range("AA:AF").Rows(f.Row).Value = Range("AA:AF").Rows(Target.Row).Value '<--| paste "Assigmnents" sheet changed cell row columns "AA:AF" content in corresponiding columns of referenced sheet ("i.e. "Checklist") row where "Emp #" match was found
        End If
    End With
End Sub

Upvotes: 1

Shai Rado
Shai Rado

Reputation: 33692

I think you are after something like the shorter code version below:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cel As Range
Dim ri As Range
Dim FndRng As Range

Application.ScreenUpdating = False

Set Cel = Range(Cells(Target.Row, 26), Cells(Target.Row, 31))

Set ri = Cells(Target.Row, "B")
Set FndRng = Sheets("Checklist").Cells.Find(What:=ri.value, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole)

If Not FndRng Is Nothing Then '<-- find was successful
    Cel.Copy
    FndRng.Offset(, 25 - FndRng.Column).PasteSpecial xlPasteValues
Else ' <-- if Find failed raise an error message box
    MsgBox "Unable to find " & ri.value & " in Sheet 'Checklist'"
End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Upvotes: 0

Related Questions