Hi Seiya
That works perfectly every time no matter what order the
sheets are in or whether there are names or not.

All I have to do now is work out how it does it. :) :)
Thank you

Geoff
-----Original Message-----
try
Sub test()
Dim ws As Worksheet, x As Name, nArray() As String
Dim i As Integer, z As String, y As String
For Each ws In Sheets
With ws
For Each x In ThisWorkbook.Names
z = Replace(Replace(Replace
(x.RefersTo, "'", "") _
, "=", ""), "!", "")
y = Left(z, InStr(z, "$") - 1)
If y = .Name Then
i = i + 1: ReDim Preserve nArray(1 To i)
nArray(i) = x.Name & vbTab & ": " & _
Replace(z, .Name, "")
End If
Next
If i 0 Then
MsgBox "Found " & i & " Named range(s) on "
& .Name _
& vbLf & vbLf & "Name" & vbTab & ": "
& "Address" & _
vbLf & Join(nArray, vbLf)
Else
MsgBox "No named range found on " & .Name
End If
End With
Erase nArray: i = 0
Next
End Sub

.