excelvbaloopsfor-loop

How do I get my For Next loop to actually loop


I have a loop, however it only finds the first iteration and doesn't loop onto the next iteration.

I've set up a loop. So far, it opens a worksheet called Names, counts rows containing IMP and EXP and assigns them to a variable. The Names worksheet contains a list. Column A is user initials, column B is user name, and column C contains either IMP or EXP depending on the user. Then the macro opens a worksheet called Averages and starts the loop.

The loop starts with a For counter equal to the number of IMP rows. The sets a range with counter. Next it looks at the Names worksheet and finds a row with IMP in it. If the cell contains data then sets the rownumber. Next it sets the variable rng cell and sets it to the current IMP row and 2 cells to the left. (User Initial) and continues to set the rng cell to the right and sets it to the current IMP row and 1 cells to the left. (User Name).

So this kind of works, It does loop through 10 times like it should however my issue is that it finds the first IMP row, and enters the User Initial and then Name. But just copies this 10 times instead of looking at the next row with IMP on it, and entering the next user initial and name. So I get 10 rows of one persons initals and name only. I have a hard time figuring out loops, Would anyone by able to please show me my error? Code below.

Worksheets("Names").Activate

Range("C2").Select
'counts the rows
 IMPRows = Application.WorksheetFunction.CountIf(Range("C:C"), "IMP")
 EXPRows = Application.WorksheetFunction.CountIf(Range("C:C"), "EXP")

Worksheets("Averages").Activate

 
'Start of loop to insert data 
 For counter = 6 To 6 + IMPRows
 Set rng = Worksheets("Averages").Cells(counter, 1)
 
 Set rng2 = Worksheets("Names").Columns("C:C").Find(What:="IMP", MatchCase:=True)
    If Not rng2 Is Nothing Then
    rownumber = rng2.Row
    rng.Offset(0, 0) = rng2.Offset(0, -2)
    rng.Offset(0, 1) = rng2.Offset(0, -1)
    Else
    End If
   
'end of loop
 Next counter

Solution

  • Lookup Using the Find Method

    A Screenshot of Both Sheets

    Option Explicit
    
    Sub LookupIMP()
    
        Const SEARCH_STRING As String = "IMP"
    
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
        
        Dim sws As Worksheet: Set sws = wb.Sheets("Names")
        Dim srg As Range:
        Set srg = sws.Range("C2", sws.Cells(sws.Rows.Count, "C").End(xlUp))
        
        Dim dws As Worksheet: Set dws = wb.Sheets("Averages")
        Dim dcell As Range: Set dcell = dws.Range("A6")
        
        Dim scell As Range: Set scell = srg.Find(What:=SEARCH_STRING, _
            After:=srg.Cells(srg.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, _
            MatchCase:=True)
        
        If scell Is Nothing Then
            MsgBox "No occurrence of """ & SEARCH_STRING & """ found!", _
               vbExclamation
            Exit Sub
        End If
            
        Dim sFirstAddress As String: sFirstAddress = scell.Address
        
        Do
            dcell.Offset(, 0).Value = scell.Offset(, -2).Value
            dcell.Offset(, 1).Value = scell.Offset(, -1).Value
            Set dcell = dcell.Offset(1)
            Set scell = srg.FindNext(After:=scell)
        Loop While scell.Address <> sFirstAddress
    
        MsgBox "Looking up """ & SEARCH_STRING & """ finished.", _
            vbInformation
        
    End Sub