VBA to search Multiple Cells for Multiple Values in Multiple Rows to Compare and Add missing Values if Necessary

[Lazarus3D]

The issue I am having has me perplexed and I can't seem to get it right. Maybe I have just been looking at it too long. I have a list of cells that are item numbered. These item numbers range from 1000 - 10000. Each item number contains data relevant to that item. What I am trying to do is have the ability to link items together so that they are easily accessible. This is basically done by adding the item number in a range of cells. That is the easy part, the difficult part is that up to 11 item numbers can be linked together. Adding one item to another works perfectly but making sure the other link cells are linked with all the item numbers is becoming an issue. This is all being done via userforms.

I have added my code so that you can see where I was going with it. As I said it works out great when adding one item number to another item number but when the number has existing links to it, it does not work at all. I am also attaching a screen shot so you can see what the attached links should be doing. Thank you in advance for anyhelp you can give me.

Private Sub Link_Click()
    
    Dim LinkRange, LinkRangeB, FoundRange, FoundRangeB As Range
    If LinkBoxA = "" Then
    MsgBox "Two Reservations Must Be Selected!!"
    Exit Sub
    
    Else
    Dim YesOrNoAnswerToMessageBox As String
    Dim QuestionToMessageBox As String
    QuestionToMessageBox = "Link Current Reservations?"
    YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "VBA Expert or Not")
    If YesOrNoAnswerToMessageBox = vbNo Then
    
    Exit Sub
    
    Else
    
    Application.ScreenUpdating = False
    
    Dim FindX As String
    Dim FindY As String
     
    FindX = LinkBoxB.Value
    FindY = LinkBoxA.Value
    Worksheets("DATA").Activate
     
    Set FoundRange = Sheets("DATA").Cells.Find(What:=FindX, LookIn:=xlFormulas, LookAt:=xlWhole)
    Set FoundRangeB = Sheets("DATA").Cells.Find(What:=FindY, LookIn:=xlFormulas, LookAt:=xlWhole)
    Set LinkRange = FoundRange.Offset(0, 51).End(xlToRight)
    Set LinkRangeB = FoundRangeB.Offset(0, 51).End(xlToRight)
    
    If FoundRange = "" Then
    Sheets("HOST").Activate
    MsgBox "Reservation Not Found!"
    Exit Sub
    End If
    
    If FoundRange.Offset(0, 62) > "" Then
    MsgBox "Too Many Linked Reservations!"
    Sheets("HOST").Activate
        Exit Sub
    
    ElseIf FoundRange.Offset(0, 52) = "" Then
    FoundRange.Offset(0, 52) = LinkBoxA.Value
    FoundRangeB.Offset(0, 52) = LinkBoxB.Value
    MsgBox "Reservation Linked Successfully!"
    Sheets("HOST").Activate
        Exit Sub
          
    Else
    LinkRange.Offset(0, 1) = LinkBoxA.Value
    LinkRangeB.Offset(0, 1) = LinkBoxB.Value
    MsgBox "Reservation Linked Successfully!"
    Sheets("HOST").Activate
    End If
    
 
    Application.ScreenUpdating = True
     
  End If
  End If
End Sub

 

[sijpie]

An example of the sheet would be useful. Use excelGenie to display it