Another Darn .FindNext Question

jaybird5013

New Member
Joined
Jul 23, 2014
Messages
5
Hello everybody,

While not a beginner, I clearly have somethings to learn here... I have not been able to get the .FindNext function to operate within my code. It's irritating because I thought I knew what I was doing. I am attempting to update a spreadsheet on the network from my desktop. This is a spreadsheet my whole team has access to, and we all add data to it. The thing is, I don't want to overwrite anyone else's information, so I've restricted the code to only work if the username (uName) on the desktop spreadsheet matches the username on the network spreadsheet (uName2). I identify the names of the applications (appName and appName2) by using offsets. Additionally, there can be multiple matches for the username and application, so to identify the correct row to be updated, the dates (fDate and fDate2) must also match. I've pored over the standard .FindNext structure for hours and tweaked and poked my code every which way, but I can't get this function to work. The error I get is "unable to get the findnext property of the range class". I'm hoping someone will point out my error! This is what I have:

Code:
Sub CountAll2()

Dim LastRow As Long
Dim uName As Range
Dim appName
Dim appName2
Dim sht
Dim I As Long
Dim cCount As Integer
Dim FileChosen As Integer


'Turning off default message alerts
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False


'This FileDialog routine prompts user to pick the appropriate file
sFile = ActiveWorkbook.Name
sht = ActiveSheet.Name
'fPath = "\\namdfs\CARDS\MWD\GROUPS\GCM_NAM\2015\00 Daily Trackers\"     'Default location of tracker folders
fPath = "\\namdfs\CARDS\MWD\GROUPS\GCM_NAM\Projects\JohnB\"        'Default folder for testing purposes only
Application.FileDialog(msoFileDialogOpen).InitialFileName = fPath
intChoice = Application.FileDialog(msoFileDialogOpen).Show
    If intChoice <> -1 Then
        MsgBox ("No file was selected.  No changes were made.") ' user has cancelled the operation
        Exit Sub
    Else:
    strpath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
        Workbooks.Open (strpath)        'Opens the selected file
    End If


If ActiveWorkbook.ReadOnly = True Then      'This checks to see if the file is currently in use
    MsgBox ("The file is locked. " & vbNewLine & "Try again later.")
    Exit Sub
Else        'If the file is not in use, then do the following:


Worksheets(sht).Activate    'Ensures that both trackers are opened to the same worksheet
sFile2 = ActiveWorkbook.Name    'Captures the name of daily tracker file
sPath2 = ActiveWorkbook.Path    'Captures the file path of the daily tracker
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Finds last row of personal tracker and assigns it a number


If ActiveSheet.FilterMode Then      'If the data is filtered, then unfilter it
  ActiveSheet.ShowAllData
End If


' The following sets the variables for the personal tracker and the daily tracker
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Finds last row of daily tracker and assigns it a number
Columns("B:B").Select
    cCount = 0
    For I = 5 To LastRow + 1        'This sets the number of rows to be examined
        Workbooks(sFile).Activate   'Activate personal tracker
        Worksheets(sht).Activate    'Activates correct worksheet
        Set uName = Cells(I, 18) 'This determines the user ID on the personal tracker
        fDate = uName.Offset(0, -10)
'        Debug.Print fDate
        If uName = UCase(Environ("username")) Then  'This only examines those user ID's that match the PC's login ID
            appName = uName.Offset(0, -17).Value 'This offset reveals the application name
            With Workbooks(sFile2).Sheets(sht).Range("A5:A" & LastRow)
                Set appName2 = .Find(appName, LookIn:=xlValues)  'This finds the application name on the daily tracker
                fDate2 = appName2.Offset(0, 7)
'                    Debug.Print fDate2
                If appName2 Is Nothing Then 'Can't find a match
                    MsgBox ("Report name " & appName & " cannot be found on " & sFile2 & "." & vbNewLine & "This information was not added" & vbNewLine & "Operation Cancelled")
                    Exit Sub
                Else
                    If Not appName2 Is Nothing Then
                        uName2 = appName2.Offset(0, 17).Value  'If it finds a matching application, this looks to see who it is assigned to
                        firstDate = fDate2
                        Do
                        If uName2 = uName And fDate2 = fDate Then      'This compares the assigned user on the daily tracker to the assigned user on the personal tracker
                        uName.EntireRow.Copy        'If the user IDs match then copy the current row on the personal tracker
                        appName2.PasteSpecial xlPasteAll    'And paste it onto the matching line on the daily tracker
                        ElseIf uName2 <> uName Then     'If the two ID's DO NOT match
                            If MsgBox("You are not currently assigned to " & appName & ".  Do you wish to insert your data on another line?", vbYesNo, "No Match") = vbYes Then
                                uName.EntireRow.Copy
                                appName2.EntireRow.Insert   'Inserts the copied data to another line if user answers yes
                            Else
                                If MsgBox("Would you like to overwrite the current data?", vbYesNo, "Overwrite?") = vbYes Then
                                    uName.EntireRow.Copy
                                    appName2.EntireRow.PasteSpecial xlPasteAll      'Overwrites the current data if user answers yes
                                Else
                                    MsgBox ("You have cancelled the operation")
                                    Exit Sub
                                End If
                            End If
                            Debug.Print appName2
                        End If
                        Set appName2 = .FindNext(appName)
                        Loop While Not appName2 Is Nothing And firstDate <> fDate2
                    End If
                End If
            End With


            cCount = cCount + 1
        End If
    Next I
'    Workbooks(sFile2).Save      'Saves daily tracker
'    Workbooks(sFile2).Close     'Closes daily tracker
    MsgBox ("Success!  The number of records updated is " & cCount)
    End If
    
'Turns default message alerts back on
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True


End Sub

I feel something of a failure for not being able to solve this on my own, but any assistance would be GREATLY appreciated!

Jaybird
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,753
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
You first use find to find appName2 not appName. The find next needs to look for appName2. Try:

Set appName2 = .FindNext(appName2)
 

jaybird5013

New Member
Joined
Jul 23, 2014
Messages
5
Thank you so much! I'm still not updating the other matches, but at least that takes care of the error! I can't believe I made such a simple mistake... d'Oh!
 
Last edited:

jaybird5013

New Member
Joined
Jul 23, 2014
Messages
5

ADVERTISEMENT

When I debug the values it looks as if appName isn't changing it's values for fDate. I will look at it some more. Thanks!
 

jaybird5013

New Member
Joined
Jul 23, 2014
Messages
5
I'm attempting to update my code to match the standard .FindNext model. This is what I have:
Code:
Sub CountAll2()

Dim LastRow As Long
Dim uName As Range
Dim appName
Dim appName2
Dim sht
Dim I As Long
Dim cCount As Integer
Dim FileChosen As Integer


'Turning off default message alerts
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False


'This FileDialog routine prompts user to pick the appropriate file
sFile = ActiveWorkbook.Name
sht = ActiveSheet.Name
'fPath = "\\namdfs\CARDS\MWD\GROUPS\GCM_NAM\2015\00 Daily Trackers\"     'Default location of tracker folders
fPath = "\\namdfs\CARDS\MWD\GROUPS\GCM_NAM\Projects\JohnB\"        'Default folder for testing purposes only
Application.FileDialog(msoFileDialogOpen).InitialFileName = fPath
intChoice = Application.FileDialog(msoFileDialogOpen).Show
    If intChoice <> -1 Then
        MsgBox ("No file was selected.  No changes were made.") ' user has cancelled the operation
        Exit Sub
    Else:
    strpath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
        Workbooks.Open (strpath)        'Opens the selected file
    End If


If ActiveWorkbook.ReadOnly = True Then      'This checks to see if the file is currently in use
    MsgBox ("The file is locked. " & vbNewLine & "Try again later.")
    Exit Sub
Else        'If the file is not in use, then do the following:


Worksheets(sht).Activate    'Ensures that both trackers are opened to the same worksheet
sFile2 = ActiveWorkbook.Name    'Captures the name of daily tracker file
sPath2 = ActiveWorkbook.Path    'Captures the file path of the daily tracker
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Finds last row of personal tracker and assigns it a number


If ActiveSheet.FilterMode Then      'If the data is filtered, then unfilter it
  ActiveSheet.ShowAllData
End If


' The following sets the variables for the personal tracker and the daily tracker
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Finds last row of daily tracker and assigns it a number
Columns("B:B").Select
    cCount = 0
    For I = 5 To LastRow + 1        'This sets the number of rows to be examined
        Workbooks(sFile).Activate   'Activate personal tracker
        Worksheets(sht).Activate    'Activates correct worksheet
        Set uName = Cells(I, 18) 'This determines the user ID on the personal tracker
        fDate = uName.Offset(0, -10)
'        Debug.Print fDate
        If uName = UCase(Environ("username")) Then  'This only examines those user ID's that match the PC's login ID
            appName = uName.Offset(0, -17).Value 'This offset reveals the application name
            With Workbooks(sFile2).Sheets(sht).Range("A5:A" & LastRow)
                Set appName2 = .Find(appName, LookIn:=xlValues)  'This finds the application name on the daily tracker
                fdate2 = appName2.Offset(0, 7)
'                    Debug.Print fDate2
                fInstance = appName2.Address
                If appName2 Is Nothing Then 'Can't find a match
                    MsgBox ("Report name " & appName & " cannot be found on " & sFile2 & "." & vbNewLine & "This information was not added" & vbNewLine & "Operation Cancelled")
                    Exit Sub
                Else
                    If Not appName2 Is Nothing Then
                        uName2 = appName2.Offset(0, 17).Value  'If it finds a matching application, this looks to see who it is assigned to
                        
                        Do
                        If uName2 = uName And fdate2 = fDate And Len(appName) = Len(appName2) Then   'This compares the assigned user on the daily tracker to the assigned user on the personal tracker
                        uName.EntireRow.Copy        'If the user IDs match then copy the current row on the personal tracker
                        appName2.PasteSpecial xlPasteAll    'And paste it onto the matching line on the daily tracker
                        ElseIf uName2 <> uName Then     'If the two ID's DO NOT match
                            If MsgBox("You are not currently assigned to " & appName & ".  Do you wish to insert your data on another line?", vbYesNo, "No Match") = vbYes Then
                                uName.EntireRow.Copy
                                appName2.EntireRow.Insert   'Inserts the copied data to another line if user answers yes
                            Else
                                If MsgBox("Would you like to overwrite the current data?", vbYesNo, "Overwrite?") = vbYes Then
                                    uName.EntireRow.Copy
                                    appName2.EntireRow.PasteSpecial xlPasteAll      'Overwrites the current data if user answers yes
                                Else
                                    MsgBox ("You have cancelled the operation")
                                    Exit Sub
                                End If
                            End If
                            Debug.Print appName2
                        End If
                        Set appName2 = .FindNext(appName2)
                        Debug.Print appName & "  "; fDate & " matches " & appName2 & "  " & fdate2
                        Loop While Not appName2 Is Nothing And fInstance <> appName2.Address
                        
                    End If
                End If
            End With


            cCount = cCount + 1
        End If
    Next I
'    Workbooks(sFile2).Save      'Saves daily tracker
'    Workbooks(sFile2).Close     'Closes daily tracker
    MsgBox ("Success!  The number of records updated is " & cCount)
    End If
    
'Turns default message alerts back on
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True


End Sub

Unfortunately it keeps finding the same value on the same line over and over. It isn't searching for different matches like it should.
 
Last edited:

jaybird5013

New Member
Joined
Jul 23, 2014
Messages
5
Bingo. Got it. The code works as adverstised. It's just that I had failed to reset the value for fDate2. I discovered this by debugging the address of the appName2 found on the second spreadsheet. Looking at it I could see that it was indeed finding matches in different cells, but the value for fDate2 wasn't changing. Obviously, I needed it to update that value after .FindNext(appName2). This fixes the problem. Thanks so much Joe!

By the way, isn't there a way to indicate that you answered my initial question? I know other sites work this way, but I can't find one here.
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,753
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Bingo. Got it. The code works as adverstised. It's just that I had failed to reset the value for fDate2. I discovered this by debugging the address of the appName2 found on the second spreadsheet. Looking at it I could see that it was indeed finding matches in different cells, but the value for fDate2 wasn't changing. Obviously, I needed it to update that value after .FindNext(appName2). This fixes the problem. Thanks so much Joe!

By the way, isn't there a way to indicate that you answered my initial question? I know other sites work this way, but I can't find one here.
You are welcome. Your reply to indicate your question was answered suffices.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,844
Messages
5,766,748
Members
425,378
Latest member
kapoor2892

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top