Doppelte Makros sichbar machen DRINGEND

Option Explicit
 
Private Const cZAB = 2 -> ab Zeile 2
Private Const cSP2 = 2
Private Const cFARBID_ROT = 3
Private Const cFARBID_ORANGE = 40

Sub Spalte2DoppelteMarkieren()
'*** mehrfach Vorkommende Werte in Spalte 2 auf dem aktiven Blatt
'*** werden farblich gekennzeichnet
'*** erste Vorkommen: Orange, zweites und weiter Vorkommen rot
 
 Dim ws As Worksheet, r As Range, Zelle As Range
 Dim lRowS As Long, lRowBefore As Long, z As Long, lAnzMehrfach As Long, lA As Long
 Dim sAddr As String
 Dim vVar As Variant
 
 Set ws = ActiveSheet
->max.Zeilezahl bestimmen
 lRowS = ws.Cells(ws.Rows.Count, cSP2).End(xlUp).Row
->Farbmarkierung löschen
 ws.Range(ws.Cells(cZAB, cSP2), ws.Cells(lRowS, cSP2)).Interior.ColorIndex = xlColorIndexNone
 
->Alle Zeilen untersuchen
 Set r = ws.Range(ws.Cells(cZAB, cSP2), ws.Cells(lRowS, cSP2))
 
 For z = cZAB To lRowS
  If ws.Cells(z, cSP2).Value <>  Then
   If ws.Cells(z, cSP2).Interior.ColorIndex = xlColorIndexNone Then
    vVar = ws.Cells(z, cSP2).Value
    If z = cZAB Then lRowBefore = lRowS Else lRowBefore = z - 1
    Set Zelle = r.Find( _
     What:=vVar, _
     After:=ws.Cells(lRowBefore, cSP2), _
     LookIn:=xlValues, _
     Lookat:=xlWhole, _
     Searchdirection:=xlNext)
    sAddr = Zelle.Address(False, False)
    lA = 0
    Do
     Set Zelle = r.FindNext(Zelle)
     If Zelle Is Nothing Then Exit Do
     If sAddr = Zelle.Address(False, False) Then Exit Do
     If lA = 0 Then lA = lA + 1
     ws.Cells(z, cSP2).Interior.ColorIndex = cFARBID_ORANGE
     Zelle.Interior.ColorIndex = cFARBID_ROT
    Loop
    lAnzMehrfach = lAnzMehrfach + lA
   End If
  End If
 Next
 
 If lAnzMehrfach = 0 Then
  MsgBox Keine Werte mehrfach vorhanden.
 Else
  MsgBox lAnzMehrfach &  Werte mehrfach vorhanden.
 End If
AUFRAEUMEN:
 Set ws = Nothing: Set r = Nothing: Set Zelle = Nothing
End Sub
'*****************************************************************

Sub Spalte2NaechsteVorkommen()
'*** springt von der aktuellen Zelle in Spalte 2
'*** zur Zelle in Spalte 2 mit dem nächsten Vorkommen des Wertes
 
 Dim ws As Worksheet, r As Range, Zelle As Range
 Dim lRowS As Long, lRowBefore As Long, z As Long
 Dim sAddr As String
 Dim vVar As Variant
 
 Set ws = ActiveSheet
 
 If Not Selection.Count = 1 Then _
  MsgBox Bitte nur eine Zelle markieren.: GoTo AUFRAEUMEN
 If Selection.Column <> 2 Then _
  MsgBox Bitte eine Zelle in Spalte  & cSP2 &  markieren.: GoTo AUFRAEUMEN
 If Selection.Row < cZAB Then _
  MsgBox Bitte eine Zelle ab Zeile  & cZAB &  markieren.: GoTo AUFRAEUMEN
 
 Set Zelle = Selection
 If Zelle.Value =  Then MsgBox Zelle ist leer: GoTo AUFRAEUMEN
 
->max.Zeilezahl bestimmen
 lRowS = ws.Cells(ws.Rows.Count, cSP2).End(xlUp).Row
 
 Set r = ws.Range(ws.Cells(cZAB, cSP2), ws.Cells(lRowS, cSP2))
 sAddr = Zelle.Address(False, False)
 vVar = Zelle.Value
 Set Zelle = r.Find( _
     What:=vVar, _
     After:=Zelle, _
     LookIn:=xlValues, _
     Lookat:=xlWhole, _
     Searchdirection:=xlNext)
 If Zelle Is Nothing Then MsgBox Wert kommt nur einmal vor. Else Zelle.Select
 
AUFRAEUMEN:
 Set ws = Nothing: Set r = Nothing: Set Zelle = Nothing
End Sub