Clickable cells and macros

[PerryK]

I am working on an excel VBA program that I am trying to use clickable cells instead of command buttons. Is it possible and if so how do I make it so that if I make a column clickable the assigned macro will work only in the same row as the cell that was clicked. For example if K5 is clicked, it will post the current time in O5 and the words "IN PROGRESS" in M5. I will need to do this in about 300 rows and I am hoping there is an efficient way to do this. Below is the code I have so far for making a column clickable cells and one of the macros I was testing.

Option Explicit
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Selection.Count = 1 Then
        If Not Intersect(Target, Range("D5:D300")) Is Nothing Then
            Call INPROGRESS1
        End If
    End If
End Sub
[\code]
The macro [code]
Sub INPROGRESS1()
'
' INPROGRESS1 Macro
'


'
    Range("M5").Select
    ActiveCell.FormulaR1C1 = "IN PROGRESS"
    Range("M6").Select
    Sheet1.Cells(5, 15).Value = Format$(Now, "hh:nn:ss")
End Sub
[\code]

Thank you for your time and assistance. I truly appreciate it.

I don't know if its important, but I do want to say I have been doing this with command buttons and someone suggested using clickable cells to be more efficient so that I don't have to make over 1200 command buttons. Thanks again

 

[PerryK]

Sheet 1

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Target.Column = 11 Then
      Cancel = True
      Target.Offset(, 2).Value = "IN PROGRESS"
      Target.Offset(, 4).Value = Time
   ElseIf Target.Column = 12 Then
      Cancel = True
      Target.Offset(, 1).Value = "COMPLETE"
      Target.Offset(, 4).Value = Time
   ElseIf Target.Column = 14 Then
      Cancel = True
      Target.Offset(, -1).Value = "PARTIAL HOLD"
      Target.Offset(, 3).Value = Time
   End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDest As Range, rngDest2 As Range, rngDest3 As Range
Dim destWbk As String
Dim wbk As Workbook
     If UCase(Target.Value) = "PARTIAL HOLD" Then
        Set rngDest = Sheet3.Range("A5:Q5")
        If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
            Application.EnableEvents = False
            Target.EntireRow.Cut
            rngDest.Insert Shift:=xlDown
            Target.EntireRow.Delete
            Application.EnableEvents = True
        End If
    ElseIf UCase(Target.Value) = "PROGRESSING" Then
        Set rngDest3 = Sheet1.Range("A5:Q5")
        If Not Intersect(Sheet3.Cells(Target.Row, Target.Column), Sheet3.Range("M5:M290")) Is Nothing Then
            Application.EnableEvents = False
            Target.EntireRow.Cut
            rngDest3.Insert Shift:=xlDown
            Target.EntireRow.Delete
            Application.EnableEvents = True
        End If
    ElseIf UCase(Target.Value) = "COMPLETE" Then
        destWbk = ThisWorkbook.Names("COMPLETED.xlsm").RefersTo
        destWbk = Replace(destWbk, "=" & Chr(34), "")
        destWbk = Replace(destWbk, Chr(34), "")
        Set wbk = Application.Workbooks(destWbk)
        Set rngDest2 = wbk.Range("A1:Q1")
        If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
             Application.EnableEvents = False
             Target.EntireRow.Cut
             rngDest2.Insert Shift:=xlDown
             Target.EntireRow.Delete
             Application.EnableEvents = True
        End If
    End If
End Sub

Sheet 3

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Target.Column < N > 14 Then Exit Sub
   Cancel = True
   Target.Offset(, -1).Value = "PROGRESSING"
End Sub

This is the entire code that I have set up so far. I am having a lot of trouble with the second code on sheet 1 and I have been getting help and adjusting it in another post. In the second code, I am getting run time errors in lines 16 and 24. What that second code is supposed to do is move a row from sheet 1 to sheet 3 when "PARTIAL HOLD" is input into column M (when you double click column N). Then on sheet 3 when "PROGRESSING" is input into column M again by double clicking column N it will move back to sheet 1. The last part is that the entire row is to be moved to another workbook when "COMPLETE" is put into column M by double clicking column L. The sheet 3 code works perfectly fine but wanted to give you as much data as I could. Thank you again, sorry for the trouble.

 

[Fluff]

Ok, try this

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
On Error GoTo Xit
   If Target.Column = 11 Then
      Cancel = True
      Target.Offset(, 2).Value = "IN PROGRESS"
      Target.Offset(, 4).Value = Time
   ElseIf Target.Column = 12 Then
      Cancel = True
      Target.Offset(, 1).Value = "COMPLETE"
      Target.Offset(, 4).Value = Time
   ElseIf Target.Column = 14 Then
      Cancel = True
      Target.Offset(, -1).Value = "PARTIAL HOLD"
      Target.Offset(, 3).Value = Time
   End If
Xit:
Application.EnableEvents = True
End Sub

 

[PerryK]

OK thank you again, your code is working perfectly in my program. now i have to figure out the other part, as none of that is working now. Thank you again. One problem solved another major one left.

 

[Fluff]

Glad to help & thanks for the feedback