Cfrgtkky

I'm still a bit new to VBA and have been working on making my own macros and all on & off. But I have a bit of an issue with a bit of code.

I have a log that I record vendor information in to, and on the worksheet, I have this code below that searches for value entered on it via number entry and it then checks to see if a name is affiliated to it from another worksheet containing the table of names.

The code below works fine for the most part, however, I have had a difficult time trying to get it to also search if the value entered has already been entered either above or below it. As it stands, when a number is entered, it pulls the name and then adds a value of 1 to a corresponding cell by the found result on the worksheet containing the list of names.

The end result I am trying to achieve, is to have it check if the name exists on the current worksheet (Not the sheet with the list of names), and if it does, will not add a value of 1 to the sheet containing all of my names and numbers.

I've tried using a loop but have had no success in getting it to work. Any help would be greatly appreciated!

If Target.Count > 1 Then Exit Sub



If Not Intersect(Target, Range("B6:B37", "B46:B77")) Is Nothing Then



If WorksheetFunction.IsNumber(Target.Value) Then



   Application.EnableEvents = False



   Vendor = Sheet8.Range("A2:B500")

   Target.Value = Application.VLookup(Target.Value, Vendor, 2, False)



   Application.EnableEvents = True



   Set StartValue = ThisWorkbook.Sheets("Vendor List").Range("A:B").Find(What:=Target.Value, LookIn:=xlValues)

   cPos = StartValue.Address



   Set ThisValue = ThisWorkbook.Sheets("Wednesday").Range("B6:B77").Find(What:=Target.Value, _

            After:=Target.Value, _

            LookIn:=xlValues, _

            LookAt:=xlPart, _

            SearchDirection:=xlNext, _

            MatchCase:=True, _

            SearchFormat:=False)



   ThisWorkbook.Sheets("Vendor List").Range(cPos).Offset(0, 8).Value = ThisWorkbook.Sheets("Vendor List").Range(cPos).Offset(0, 8).Value + 1



End If



If IsError(Target.Value) Then



    Target.Value = ""

    MsgBox "The Vendor number entered is not listed. Either you have entered an invalid number, or you have not yet added this vendor to the Vendor List sheet.", vbCritical

    ThisWorkbook.Sheets("Vendor List").Range(cPos).Offset(0, 8).Value = ThisWorkbook.Sheets("Vendor List").Range(cPos).Offset(0, 8).Value - 1



End If



End If

I've attached an image of how it works. Hopefully, it clears a bit up...

Example

Untested:

Private Sub Worksheet_Change(ByVal Target As Range)

    Const RNG_VENDOR As String = "B6:B37,B46:B77"



    Dim v, f As Range, vendor, vendorCount



    If Target.Count > 1 Then Exit Sub

    If Intersect(Target, Me.Range(RNG_VENDOR)) Is Nothing Then Exit Sub



    v = Target.Value

    If IsNumeric(v) And Len(v) > 0 Then



       'see if there's a numeric match

       Set f = Sheet8.Range("A:A").Find(v, lookat:=xlWhole, LookIn:=xlValues)

       If Not f Is Nothing Then

            vendor = f.EntireRow.Cells(1, "B").Value 'get the vendor name

            '#### edit below to fix lookup range

            vendorCount = Application.CountIf(Me.Range("B6:B77"), vendor) 'count any existing

            'update the vendors sheet?

            With f.EntireRow.Cells(1, "J")

                If vendorCount = 0 Then .Value = .Value + 1

            End With

            Application.EnableEvents = False

            Target.Value = vendor 'switch from vendor number to vendor name

            Application.EnableEvents = True



       Else

            Application.EnableEvents = False

            Target.Value = ""   'clear the value

            Application.EnableEvents = True

            MsgBox "The Vendor number '" & v & "' entered is not listed....", vbExclamation

       End If   'was found

    End If      'is a number



End Sub