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
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