Sub OverzichtVanZoeken()
Dim c As Range
Dim l As Long
Dim aantal As Long
Dim shGegevens As Worksheet
Dim strName As String
Set shGegevens = Sheets("Gegevens")
With Sheets("Samenvatting")
.Rows("2:" & Rows.Count).ClearContents
aantal = 0
For Each c In FindAll(ActiveSheet.Cells, "Wigi", xlFormulas, xlPart, xlByColumns, False)
aantal = aantal + 1
'Map
.Range("A" & 1 + aantal).Value = c.Parent.Parent.Name
'Blad
.Range("B" & 1 + aantal).Value = c.Parent.Name
'Naam
On Error Resume Next
strName = c.Name
If Err.Number = 0 Then
For l = 1 To ThisWorkbook.Names.Count
If ThisWorkbook.Names(l).RefersTo = strName Then
.Range("C" & 1 + aantal).Value = ThisWorkbook.Names(l).Name
Exit For
End If
Next
End If
On Error GoTo 0
'Cel
.Range("D" & 1 + aantal).Value = c.Address
'Waarde
.Range("E" & 1 + aantal).Value = c.Value
'Formule
If c.HasFormula Then .Range("F" & 1 + aantal).Value = "'" & c.Formula
Next c
.Columns(1).Resize(, 6).EntireColumn.AutoFit
End With
End Sub
Function FindAll(SearchRange As Range, FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False) As Range
Dim FoundCell As Range
Dim FoundCells As Range
Dim LastCell As Range
Dim FirstAddr As String
With SearchRange
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = SearchRange.Find(what:=FindWhat, after:=LastCell, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
Set FoundCells = FoundCell
FirstAddr = FoundCell.Address
Do
Set FoundCells = Application.Union(FoundCells, FoundCell)
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
End If
If FoundCells Is Nothing Then
Set FindAll = Nothing
Else
Set FindAll = FoundCells
End If
End Function
