How do I combine these 2 procedures into one?

[Ironman]

Hi

I currently have 2 separate procedures, 1 of the procedures runs for each sheet, that insert the same symbol into a cell in either Column I of Sheet "Training Log" or Column K of Sheet "Indoor Bike" (the code for the symbol insertion is identical for both sheets).

The only difference between the 2 procedures is the column number (and the sheet name).

There are other sheets in the workbook and I don't want the procedures to run for any of those.

Procedure 1:

Sub GlobalCommentsCellTrainingLog()
If ActiveSheet.Name <> "Training Log" Then
MsgBox "This function will only run in Training Log", vbInformation, "Function Invalid in This Sheet"
Exit Sub
Else
End If

'If Selection.Value <> "" Then Exit Sub
  If Selection.Column <> 9 Then
    Ans = MsgBox("This function will only run in Column I!" & vbNewLine & _
    "Would you like to move to column I now?", vbYesNo + vbExclamation, "Column Selection Error")
    If Ans = vbNo Then Exit Sub
    If Ans = vbYes Then
        Dim i As Long
        i = Selection.Row
            Cells(i, 9).Select
    End If
  End If
On Error GoTo Quit

Procedure 2:

Sub GlobalCommentsCellIndoorBike()
If ActiveSheet.Name <> "Indoor Bike" Then
MsgBox "This function will only run in Indoor Bike Sheet", vbInformation, "Function Invalid in This Sheet"
Exit Sub
Else
End If

'If Selection.Value <> "" Then Exit Sub
  If Selection.Column <> 11 Then
    Ans = MsgBox("This function will only run in Column K!" & vbNewLine & _
    "Would you like to move to column K now?", vbYesNo + vbExclamation, "Column Selection Error")
    If Ans = vbNo Then Exit Sub
    If Ans = vbYes Then
        Dim i As Long
        i = Selection.Row
            Cells(i, 11).Select
    End If
  End If
On Error GoTo Quit

I'd be really grateful if the 2 procedures can be combined into 1, so that if Excel identifies the current sheet as one of those in the 2 procedures then it will run.

Many thanks

 

[AB1984]

Something like this should probably work:

Sub GlobalCommentsCellIndoorBike()
If ActiveSheet.Name <> "Indoor Bike" and ActiveSheet.Name <> "Training Log" Then
MsgBox "This function will only run in Indoor Bike or Training Log Sheets", vbInformation, "Function Invalid in This Sheet"
Exit Sub
Else
End If
If ActiveSheet.Name = "Indoor Bike" then
ColumnNum = 11
else
ColumnNum = 9
end if
'If Selection.Value <> "" Then Exit Sub
If Selection.Column <> 11 Then
Ans = MsgBox("This function will only run in Column K on the Indoor Bike shoot or Column I on the Training Log sheet"!" & vbNewLine & _
"Would you like to move to the correct column now?", vbYesNo + vbExclamation, "Column Selection Error")
If Ans = vbNo Then Exit Sub
If Ans = vbYes Then
Dim i As Long
i = Selection.Row
Cells(i, ColumnNum).Select
End If
End If
On Error GoTo Quit

 

[Fluff]

How about

Sub GlobalCommentsCell()
   Dim Clmn As Long
   
   If ActiveSheet.Name <> "Training Log" And ActiveSheet.Name <> "Indoor Bike" Then
      MsgBox "This function will only run in Training Log & Indoor Bike", vbInformation, "Function Invalid in This Sheet"
      Exit Sub
   End If

   Select Case ActiveSheet.Name
      Case "Indoor Bike"
         Clmn = 11
      Case "Training Log"
         Clmn = 9
   End Select
   
   If Selection.Column <> Clmn Then
      If MsgBox("This function will only run in Column " & Chr(Clmn + 64) & " !" & vbNewLine & _
         "Would you like to move to column I now?", vbYesNo + vbExclamation, "Column Selection Error") = vbNo Then
         Exit Sub
      Else
         Cells(ActiveCell.Row, Clmn).Select
      End If
   End If
   On Error GoTo Quit

 

[Misca]

Try

Dim c As RangeDim ColNum As Integer
Dim ColLet As String
Dim i As Long
Dim Ans As Integer


Select Case ActiveSheet.Name
    Case Is = "Indoor Bike"
        ColNum = 11
        ColLet = "K"
    Case Is = "Training Log"
        ColNum = 9
        ColLet = "I"
    Case Else
        ColNum = 0
End Select


If ColNum = 0 Then
    MsgBox "This function will not run on this sheet", vbInformation, "Function Invalid in This Sheet"
    Exit Sub
Else


    If Selection.Column <> ColNum Then
    
        Ans = MsgBox("This function will only run in Column " & ColLet & "!" & vbNewLine & _
                "Would you like to move to column I now?", vbYesNo + vbExclamation, "Column Selection Error")
    
        If Ans = 7 Then Exit Sub
    
        If Ans = 6 Then
            i = Selection.Row
                Cells(i, ColNum).Select
        End If
  End If


End If

 

[Ironman]

Many thanks guys, I'm away from my PC until tomorrow, then I'll post a proper reply as soon as I can.

 

[Norie]

Ironman

When/how do you want these 2 sets of code to run?

 

[Ironman]

Hi Norie. When I click an assigned button on the toolbar.

 

[Ironman]

Many thanks for your solutions guys, they all work perfectly and I'm very grateful.

 

[Fluff]

Glad we could help & thanks for the feedback