Double Click event

[Lenard]

Hi,

After several attempts but fails to rectify the error in the following codes where the selected cell is double-clicked, the cursor fails to move to the colored ( yellow) row in the next columns and no message prompts : -

Private Sub Worksheet_BeforeDoubleClick( _
ByVal Target As Excel.Range, Cancel As Boolean)

Dim icol As Integer
Select Case Target.Column
Case 2 ' column B
For icol = 2 To Cells(Target.Row, Columns.Count).End(xlToLeft).Column
If Cells(Target.Row, icol).Interior.ColorIndex = 6 Then
Cells(Target.Row, icol).Select
MsgBox Application.WorksheetFunction.Text(Cells(1, icol), "dd-mmmm-yyyy") _
& " " & Application.WorksheetFunction.Text(Cells(1, icol), "dddd") _
& " " & Cells(Target.Row, icol) & " day", vbOKOnly
End If
Next icol
Cells(Target.Row, Target.Column).Offset(0, 1).Select
End Select

End Sub

Any helps will be appreciated on the above problem and thanks in advance

Regards
Len

 

[Lenard]

Actually, I have a list of staff names in column B with respective rows being filled up with one color ( yellow ) for one cell from column D to KW where column header is date and weekdays.

The result that I require is, when I double click a staff name at B10, it will move to left columns and stops at N10 ( ie filled up colored row) where it will prompt a message box "11-Mar-2011 Friday day", then I click OK, it searches and moves to next column again until it finds and stops at the next filled up colored row, say at AE10 and prompts message box "28-Mar-2011 Monday day".
If AE10 is the last used colored row, it will move back to C10 after I click OK

I hope this is clear about the steps of double click event used for the above example

 

[Lenard]

Hi,

Can anyone help on the above problem ?

Thanks
Len

 

[Arvind1977]

i properly have not made this what you want but i have made a working mouse clicking code i am pasting it below .


Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Public Sub LeftClick()
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Public Sub MoveMouse(xMove As Long, yMove As Long)
mouse_event MOUSEEVENTF_MOVE, xMove, yMove, 0, 0
End Sub
Function Wait(seconds As Long) As Boolean
Dim tick As Long, tick2 As Long, Num As Long
Num& = seconds& * 1
tick& = GetTickCount()
tick2& = GetTickCount()
Do Until tick2& - tick& >= Num&
tick2& = GetTickCount()
DoEvents
Loop
End Function

Sub Pakistan() ' Open Line 02
SetCursorPos 190, 350
Wait 2500
LeftClick
End Sub


see if this thing helps you.

 

[mikerickson]

Perhaps

Private Sub Worksheet_BeforeDoubleClick( _
ByVal Target As Excel.Range, Cancel As Boolean)

    Dim icol As Integer
    Select Case Target.Column
        Case 2 ' column B
            For icol = 2 To Cells(Target.Row, Columns.Count).End(xlToLeft).Column
                If Cells(Target.Row, icol).Interior.ColorIndex = 6 Then
                    Cells(Target.Row, icol).Select
                    MsgBox Application.WorksheetFunction.Text(Cells(1, icol), "dd-mmmm-yyyy") _
                        & " " & Application.WorksheetFunction.Text(Cells(1, icol), "dddd") _
                        & " " & Cells(Target.Row, icol) & " day", vbOKOnly
                    [B]Exit Sub[/B]
                End If
            Next icol
            Cells(Target.Row, Target.Column).Offset(0, 1).Select
    End Select

End Sub