BeforeDoubleClick ile hücreye veri girme

[mersilen]

selamlar

BeforeDoubleClick ile a10:a25 hücreleri çift tıklanınca a1 deki hücre saatine göre (0-6=1, 6-12=2, 12-18=3, 18-24=4)
aynı satırdaki c sütununa bu değerleri girip hücreyi renklendirecek kod yazılacak
ilgilenenelere şimdiden tşk

 

[mersilen]

tekrar selamlar
konu halen güncel

kendimce birşeyler yaptım ama döngü hatalı oluyor
değerlendirmeniz mümkün mü?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [a10:a20]) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False

Dim i, k As Integer
i = Range("a40").Value

i = Target.Row
Cells(i, 3) = i
Cells(i, 4) = Now
Cells(i, 4).NumberFormat = "hh"
Cells(i, 4).Interior.ColorIndex = 4

k = Cells(i, 4).Value

If 0 <= k < 6 Then Cells(i, 5) = 1
   Else: If 6 <= k < 12 Then Cells(i, 5) = 2
        Else: If 12 <= k < 18 Then Cells(i, 5) = 3
              Else: If 18 <= k < 24 Then Cells(i, 5) = 4
                    End If
              End If
        End If
End If

 Application.ScreenUpdating = True
End Sub