Merhabalar
Aşağıdaki kod düzeneğinde H sütununda herhangi bir hücreye yine h sütununda başka bir hücrede varolan bir değeri yazmışsam bana msgbox ile uyarı veriyor ve bu yazdığım değeri ve diğer benzer değeri kırmızı renge çeviriyor.
sadece ufak bir işlem istiyorum bu kod üstünde msgbox üstünde uyarı verdiğinde bu girdiğim değer hangi hücrelerde mevcut bunuda göstersin istiyorum. bilgi ve yardımlarınızı rica ederim
Aşağıdaki kod düzeneğinde H sütununda herhangi bir hücreye yine h sütununda başka bir hücrede varolan bir değeri yazmışsam bana msgbox ile uyarı veriyor ve bu yazdığım değeri ve diğer benzer değeri kırmızı renge çeviriyor.
sadece ufak bir işlem istiyorum bu kod üstünde msgbox üstünde uyarı verdiğinde bu girdiğim değer hangi hücrelerde mevcut bunuda göstersin istiyorum. bilgi ve yardımlarınızı rica ederim
Kod:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Local Error GoTo cikis
If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Range("H:H"), Target) > 1 Then
MsgBox "Benzer Veri Girişi Yapıldı. Kontrol Ederek Düzeltiniz", vbCritical, "Uyarı"
End If
If Target.Row = 1 Then Exit Sub
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Dim myDataRng As Range
Dim cell As Range
Set myDataRng = Range("H2:H" & Cells(Rows.Count, "H").End(xlUp).Row)
For Each cell In myDataRng
cell.Offset(0, 0).Font.Color = vbBlack
If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
cell.Offset(0, 0).Font.Color = vbRed
End If
Next cell
Set myDataRng = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub