My loops seems to be filling information even if a match isn't found

Question

I have the loop below that I use to find information in another sheet and fill into the one I'm working on. I would like the loop to not update if a value isn't found. However it seems to update with the line above and I can't figure out why. Your help would be greatly appreciated.

updrng1 is the cell I'm using for my loop and WorkRng1 is the range for my current sheet I'd like updated WorkRng2 is the range that the identifier in WorkRng1 I'm looking for a match

Public variables:

Option Explicit
Public WorkRng1 As Range
Public WorkRng2 As Range
Public WorkRng3 As Range
Public Rng1 As Range
Public Rng2 As Range
Public Rng3 As Range
Public blkRow As Range
Public subTskRng As Range
Public UOMRng As Range
Public nmbrRng As Range
Public unitCostRng As Range

This is my form code:

Private Sub CommandButton1_Click()
Dim updRange1 As Range

Set updRange1 = Application.InputBox("Please select all Tasks ID Cells you would like to update", "Title", Type:=8)
Application.ScreenUpdating = False

updRange1.NumberFormat = "@"

Dim matchCounter As Integer
matchCounter = 0

Dim FoundRange As Range
    For Each updrng1 In updRange1
    ''tests task exists in work range 2
    WorkRng2.Parent.Activate
    If updrng1 <> 0 Then
        Set FoundRange = WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If FoundRange Is Nothing Then
            MsgBox "test" & updrng1
        Else
    'updates subtask info
            WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
            If Cells(ActiveCell.Row, subTskRng.Column) <> 0 Then
                Cells(ActiveCell.Row, subTskRng.Column).Copy
            Else
                Cells(ActiveCell.Row, subTskRng.Column - 1).Copy
        End If
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtSubTask.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    'updates UOM info
        WorkRng2.Parent.Activate
        WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, UOMRng.Column).Copy
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtUOM.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    'updates Number of units info
        WorkRng2.Parent.Activate
        WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, nmbrRng.Column).Copy
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtNoUnits.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    'updates Units Cost info
        WorkRng2.Parent.Activate
        WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, unitCostRng.Column).Copy
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtUnitCost.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        If Me.txtBgtTotal.Value <> "" Then
            Cells(ActiveCell.Row, Me.txtBgtTotal.Value).Formula = "=" & Me.txtNoUnits.Value & updrng1.Row & "*" & Me.txtUnitCost.Value & updrng1.Row
        End If
        matchCounter = matchCounter + 1
    End If
    End If
    Next

    updRange1.NumberFormat = "0.0"

Application.ScreenUpdating = True
If matchCounter > 0 Then MsgBox matchCounter & " Tasks Updated!", vbInformation, "Success!"
    'Clear input controls
    Me.txtSubTask.Value = ""
    Me.txtUOM.Value = ""
    Me.txtNoUnits.Value = ""
    Me.txtUnitCost.Value = ""
    Me.txtBgtTotal.Value = ""
    txtSubTask.SetFocus
    Exit Sub
Whoa:
        Select Case Err.Number
            Case 1004
                MsgBox "Check Your Column Letters!", vbInformation, "Oops!"
        End Select

End Sub

This could really benefit from [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). This also only appears to be a snippet of code. Best guess is that you're not testing your range.find for nothing. — tigeravatar, Feb 27 '18 at 17:29
@tigeravatar in the big edit i've tried adding in the test when I run it though it fails, any thoughts? — Mike Mann, Feb 27 '18 at 18:00
Can you please provide the whole sub's code? We can't see how `updRange1`, `WorkRng2`, `WorkRng1`, etc are assigned. — tigeravatar, Feb 27 '18 at 18:05
@tigeravatar i've added in the form code, some of the variables are public though and are set in different subs — Mike Mann, Feb 27 '18 at 18:08
So in your cases `updrng1` must not be 0 and `FoundRange` is finding something, so when these false positives go through you need to `Debug.Print` their values and figure out why. — dwirony, Feb 27 '18 at 18:22
@dwirony thank you for your help. i actually removed my error handling and found a different problem that I fixed. now it's working. another question though, is there a way to keep track of values not found and display them all after my loop finishes? right now i have to click okay for each value not found — Mike Mann, Feb 27 '18 at 18:27
@MikeMann You could `Debug.Print updrng1` to the immediate window, or maybe just paste them onto another worksheet one by one. — dwirony, Feb 27 '18 at 18:30
@dwirony seems like the immediate window would be easiest. is there a way to display that in a msgbox? — Mike Mann, Feb 27 '18 at 18:49
@MikeMann Sorry I'm not being clear - the immediate window would appear in the VBA developer screen - open up your code and type Ctrl + G, you'll see a box open up at the bottom. You can run your code from the developer screen by pressing F5, and then `Debug.Print` will display values in that box there. — dwirony, Feb 27 '18 at 18:57
@dwirony thank you for clarifying. my question wasn't clear either. I'm trying to see if there is a way to display this print into a msgbox rather then having to open the immediate window — Mike Mann, Feb 27 '18 at 18:59
@MikeMann Ahh. Well that depends on how big your ranges are - `MsgBox` has a character limit. If you don't have long strings and a lot of data, you could place the values into an array and just print them out on a `MsgBox` that way. — dwirony, Feb 27 '18 at 19:57
@dwirony brilliant, updated. i'll post my working code in a bit — Mike Mann, Feb 27 '18 at 20:43

score 1 · Accepted Answer · answered Feb 27 '18 at 20:54

With the help of everyone in the comments I was able to get the code below working. Bonus: I even added in a mismatch error counter that displays the array in a txtbox.

For those interested here is my working code:

Private Sub CommandButton1_Click()
Dim updRange1 As Range
Dim list As String
On Error GoTo Whoa
Set updRange1 = Application.InputBox("Please select all Tasks ID Cells you would like to update", "Update Range", Type:=8)
Application.ScreenUpdating = False

updRange1.NumberFormat = "@"

Dim matchCounter As Integer
Dim errorCounter As Integer
matchCounter = 0
errorCounter = 0
Dim FoundRange As Range

    For Each updrng1 In updRange1
    ''tests task exists in work range 2
    WorkRng2.Parent.Activate
    If updrng1 <> 0 And updrng1 <> "Sub Total - Labor Fees" And updrng1 <> "Sub Total - Meetings" And updrng1 <> 21 Then
        Set FoundRange = WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If FoundRange Is Nothing Then
            list = list & updrng1 & ", "
            errorCounter = errrorCounter + 1
        Else
    'updates subtask info
    If Me.txtSubTask.Value <> 0 Then
            WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
            If Cells(ActiveCell.Row, subTskRng.Column) <> 0 Then
                Cells(ActiveCell.Row, subTskRng.Column).Copy
            Else
                Cells(ActiveCell.Row, subTskRng.Column - 1).Copy
            End If
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtSubTask.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
    'updates UOM info
    If Me.txtUOM.Value <> 0 Then
        WorkRng2.Parent.Activate
        WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, UOMRng.Column).Copy
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtUOM.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
    'updates Number of units info
    If Me.txtNoUnits.Value <> 0 Then
        WorkRng2.Parent.Activate
        WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, nmbrRng.Column).Copy
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtNoUnits.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
    'updates Units Cost info
    If Me.txtUnitCost.Value <> 0 Then
        WorkRng2.Parent.Activate
        WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, unitCostRng.Column).Copy
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtUnitCost.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
    If Me.txtBgtTotal.Value <> "" Then
        Cells(ActiveCell.Row, Me.txtBgtTotal.Value).Formula = "=" & Me.txtNoUnits.Value & updrng1.Row & "*" & Me.txtUnitCost.Value & updrng1.Row
    End If
        matchCounter = matchCounter + 1
    End If
    End If
    Next

    updRange1.NumberFormat = "0.0"

Application.ScreenUpdating = True
If matchCounter > 0 Then MsgBox matchCounter & " Tasks Updated!", vbInformation, "Success!"
If errorCounter > 0 Then MsgBox "Mismatches: " & list, vbInformation, "Please update the following tasks manually!"
    'Clear input controls
    Me.txtSubTask.Value = ""
    Me.txtUOM.Value = ""
    Me.txtNoUnits.Value = ""
    Me.txtUnitCost.Value = ""
    Me.txtBgtTotal.Value = ""
    txtSubTask.SetFocus
    Exit Sub
Whoa:
        Select Case Err.Number
            Case 1004
                MsgBox "Check Your Column Letters!", vbInformation, "Oops!"
        End Select

End Sub

My loops seems to be filling information even if a match isn't found

1 Answers1