Hoi,
I need some help...
Kort geschetst zit ik met een tabel, waarin een vaste range van meerdere rijen en kolommen zal worden ingevuld.
Nu is het de bedoeling dat wanneer ik de tabel invul, alle gelijke cellen/waarden opgelicht worden in éénzelfde kleur.
D.w.z. dat er in één tabel dus meerdere verschillende elementen in veelvoud zullen voorkomen en er dus ook VERSCHILLENDE kleuren moeten verschijnen.
De voorwaardelijke opmaakmethode ken ik en is mogelijk, maar gaat in mijn geval enorm lang duren (500 verschillende waarden + verschillende tabbladen).
Ik wil dit doen met VBA.
Online heb ik onderstaande code gevonden en aangepast naar mijn tabelrange ("C5:BL100").
Deze code heb ik dan gelinkt aan een CHECKBOX.
Deze code werkt maar één niet altijd en twee slechts voor een aantal elementen.
Ik heb een basis VBA, maar kan de fout niet vinden.
En ik vind nergens een juiste(re) code.
Kan iemand mij helpen met onderstaande te optimaliseren of een andere oplossing welke ik kan gebruiken als macro?
Merci,
-------------------------------------------------------------------------------
Sub InkleuringDubbelen()
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xChar As String
Dim xCellPre As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim I As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Range("C5:BL100")
xCIndex = 2
Set xCol = New Collection
For Each xCell In xRg
On Error Resume Next
xCol.Add xCell, xCell.Text
If Trim(xCell.Value) <> "" Then
If Err.Number = 457 Then
xCIndex = xCIndex + 1
Set xCellPre = xCol(xCell.Text)
If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
ElseIf Err.Number = 9 Then
MsgBox "Teveel dezelde werfnummers!", vbCritical, "Inkleuren"
Exit Sub
End If
End If
On Error GoTo 0
Next
End Sub
I need some help...
Kort geschetst zit ik met een tabel, waarin een vaste range van meerdere rijen en kolommen zal worden ingevuld.
Nu is het de bedoeling dat wanneer ik de tabel invul, alle gelijke cellen/waarden opgelicht worden in éénzelfde kleur.
D.w.z. dat er in één tabel dus meerdere verschillende elementen in veelvoud zullen voorkomen en er dus ook VERSCHILLENDE kleuren moeten verschijnen.
De voorwaardelijke opmaakmethode ken ik en is mogelijk, maar gaat in mijn geval enorm lang duren (500 verschillende waarden + verschillende tabbladen).
Ik wil dit doen met VBA.
Online heb ik onderstaande code gevonden en aangepast naar mijn tabelrange ("C5:BL100").
Deze code heb ik dan gelinkt aan een CHECKBOX.
Deze code werkt maar één niet altijd en twee slechts voor een aantal elementen.
Ik heb een basis VBA, maar kan de fout niet vinden.
En ik vind nergens een juiste(re) code.
Kan iemand mij helpen met onderstaande te optimaliseren of een andere oplossing welke ik kan gebruiken als macro?
Merci,
-------------------------------------------------------------------------------
Sub InkleuringDubbelen()
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xChar As String
Dim xCellPre As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim I As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Range("C5:BL100")
xCIndex = 2
Set xCol = New Collection
For Each xCell In xRg
On Error Resume Next
xCol.Add xCell, xCell.Text
If Trim(xCell.Value) <> "" Then
If Err.Number = 457 Then
xCIndex = xCIndex + 1
Set xCellPre = xCol(xCell.Text)
If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
ElseIf Err.Number = 9 Then
MsgBox "Teveel dezelde werfnummers!", vbCritical, "Inkleuren"
Exit Sub
End If
End If
On Error GoTo 0
Next
End Sub