Een lijst met opbergplaatsen (genaamd rng) mag alleen maar codes bevatten die in een tabel op een ander tabblad voorkomen.
Mijn eerste lering: Intersect werkt niet met data op twee tabbladen.
Daarom eerst maar even kopieëren naar hetzelfde tabblad (nu rngLoclist)
Toch werkt onderstaande code niet.
Wat doe ik fout?
Mijn eerste lering: Intersect werkt niet met data op twee tabbladen.
Daarom eerst maar even kopieëren naar hetzelfde tabblad (nu rngLoclist)
Toch werkt onderstaande code niet.
Wat doe ik fout?
Code:
Function InRange(Range1 As Range, Range2 As Range) As Boolean
' returns True if Range1 is within Range2
InRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
End Function
Private Sub cmbCheck_Click()
Dim lastrow1, lastrow2, errors, max
Dim rngDest, rng, rngLoclist, c As Range
lastrow1 = Worksheets("Inventarislijst").Cells(ActiveSheet.Rows.Count, "A").End(xlUp).row
Set rng = Range("$C2:$C" + CStr(lastrow1))
'MsgBox rng.Address
Worksheets("Opslaglocaties").Range("A2:A1000").Copy ActiveSheet.Range("AA1")
lastrow2 = Cells(ActiveSheet.Rows.Count, "AA").End(xlUp).row
Set rngLoclist = Range("$AA1:$AA" + CStr(lastrow2))
'MsgBox rngLoclist.Address
For Each c In rng
If InRange(ActiveCell, rngLoclist) Then
c.Interior.ColorIndex = 4 'Light green
'Within range
Else
'Outside range MsgBox c.Value
c.Interior.ColorIndex = 3 'Red
errors = errors + 1
End If
Next
If errors > 0 Then
MsgBox "Er zijn " & errors & " fouten in de kolom (rood gemarkeerd)."
Else
MsgBox "Er zijn geen fouten in de kolom gevonden"
End If
End Sub
Laatst bewerkt door een moderator:
