Многократный вызов функции

Question

У меня проблема с моим кодом.

На листе «Основные» у меня есть следующий код:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error Resume Next


Application.EnableEvents = False
Application.Calculation = xlManual
Application.ScreenUpdating = False
ThisWorksheet.EnableCalculation = False

Set Target = Tabelle1.Range("D6")

If Not Intersect(ActiveCell, Target) Is Nothing Then

    Dim OpenFiles As String
    wbcount = Application.Workbooks.count

    For i = 1 To wbcount
        If OpenFiles = "" Then
            OpenFiles = Application.Workbooks(i).Name
        Else
            OpenFiles = OpenFiles & "," & Application.Workbooks(i).Name
        End If

    Next

    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=OpenFiles
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End If

End Sub

Это позволяет выбрать открытые рабочие книги из выпадающего списка. Я использую несколько разных функций, которые вызываются в выбранных ячейках в «основном» листе. Моя проблема в том, что у меня есть некоторые InputBoxes внутри этих функций: они все вызываются дважды, как мне избежать этой проблемы?

Код для примера Функция:

Код для одной из функции:

Public Function getSerialStr(hcc1 As String)
    Dim wb As Workbook

    Set wb = Workbooks(hcc1)

    Dim i As Integer, j As Integer, count As Integer
    Dim hcc As Worksheet





    For i = 1 To wb.Worksheets("Table 1").UsedRange.Rows.count
        For j = 1 To 15


        If InStr(1, wb.Worksheets("Table 1").Cells(i, j).Value2, "Serial", 1) > 0 Then

        itis = wb.Worksheets("Table 1").Cells(i + 1, j).Value



        If Len(itis) < 4 Then
            itis = InputBox("No Serial found, please type in manually!", "Serial Missing" & vbCrLf)



        GoTo ende


        End If


        GoTo ende


        End If


        Next j
    Next i

ende:
 getSerialStr = itis

End Function