Do While Issue

[cadetSean]

Hello, I am having a problem with my DoWhile loop where I get the same results each time the code loops. So let's say the Companies A, b, and c should yield 1,2, 3. I am getting 1 for a, b, and c. But when I change the code so it starts at 2, I get b=2 and c=2.

Sub Macro2()
'
' Macro2 Macro
'

'
  Dim FileName As String
  Dim FileNames As String
Dim i As Integer

i = 3

       FileName = Cells(i, 1).Value
        FileNames = Cells(i, 2).Value
        
    Do While Cells(i, 1).Value <> ""
    
    Application.DisplayAlerts = False
    
    Range("F2").Select
    Selection.Copy
   
    If Len(Dir("O:\Leasing\PORTFOLIO REPORTS\" & FileName & "")) > 0 Then
    Workbooks.Open FileName:= _
        "O:\Leasing\PORTFOLIO REPORTS\" & FileName & ""

    ElseIf Len(Dir("O:\Leasing\PORTFOLIO REPORTS\" & FileName & "")) = 0 Then
    Workbooks.Open FileName:= _
        "O:\Leasing\PORTFOLIO REPORTS\" & FileNames & ""
    
    End If
   
    Range("P6").Select
    Cells.Find(What:=Workbooks("Data Finder.xlsm").Worksheets(1).Range("F2"), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(2, 0).Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=COUNTIF(R[1]C:R[65524]C,""*SD*"")"
    ActiveCell.Select
    Selection.Copy
    Windows("Data Finder.xlsm").Activate
    Cells(i, 6).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows(2).Activate
    ActiveWindow.Close
    
    i = i + 1
    
    Loop
    Application.DisplayAlerts = True

End Sub