Dim strRange As String

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strRange As String

strRange = Target.Cells.Address
If Not Target.Cells.Value = "O" Then
Range(strRange).Interior.Color = vbYellow
Range(strRange).Replace "*", "O"
Cells(Target.Row, 9).Value = Cells(Target.Row, 9).Value + Cells(2, Target.Column).Value
Cells(Target.Row, 9).Interior.Color = vbYellow
Cells(Target.Row, 12).Value = Cells(Target.Row, 12).Value + 1
Cells(Target.Row, 11).Value = Cells(Target.Row, 11).Value + Cells(2, Target.Column).Value

End If
End Sub

 

Sub RemoveAlphas()
'Updateby20131129
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
For Each Rng In WorkRng
    xOut = ""
    For i = 1 To Len(Rng.Value)
        xTemp = Mid(Rng.Value, i, 1)
        If xTemp Like "[a-z.]" Or xTemp Like "[A-Z.]" Then
            xStr = ""
        Else
            xStr = xTemp
        End If
        xOut = xOut & xStr
    Next i
    Rng.Value = xOut
Next
End Sub