End Double Sub

[Zurn]

Ok, I understand, but in the code below, this is not that easy.

Sub Submitt()

cellRun = Worksheets("invoer").Cells(4, 4)
If IsEmpty(cellRun) Then
Response = MsgBox("Run blank!", vbExclamation, "Input error")
If Response = vbOK Then
Worksheets("invoer").Cells(4, 4).Select
End If
Else
Application.ScreenUpdating = False

Dim K As Long
K = Sheets("invoer").Range("B12").Value
Select Case K
Case 1
*BasicInfo 2*
PutColMach "D19", "A1", 6
Case 2
*BasicInfo 2*
PutColMach "D19", "A1", 8
End Select

If Worksheets("invoer").Range("B14").Value Then
*BasicInfo 20*
PutColMach "D27", "A1", 6
End If

Sheets("invoer").Select
Sheets("invoer").Unprotect
Range("D67,D19:J19,D27:F27,F21:K21").Select
Selection.ClearContents
Sheets("invoer").Protect
Range("D4").Select
Range("D4").Value = Range("D4").Value + 1
End If



Application.ScreenUpdating = True
End Sub


SUB BASICINFO(BYVAL CR AS INTEGER
Dim stoprow As Integer
Dim cc As Long
cc = Sheets("invoer").Range("B9").Value
stoprow = 5 + (cc - 1) * 9
-*cellRun = Worksheets("invoer").Range("D4").Value*-

Worksheets("collect").Activate
Cells(stoprow, cR).Activate
*-Do While Not IsEmpty(ActiveCell) 'search th
free cell, if same
If cellRun = ActiveCell.Value Then
'number, stop completely
r = MsgBox("Deze run werd reeds ingevoerd.", vbOKOnly)
Exit Sub
End If-*
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.Range("A1") = Sheets("invoer").Range("D4").Value
ActiveCell.Offset(0, 1).Range("A1")
Sheets("invoer").Range("D6").Value
ActiveCell.Offset(0, 2).Range("A1")
Sheets("invoer").Range("D7").Value
End Sub


Suggestions