@shg you are dead right - my bad - it should be
Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
            Loop While c.Address <> firstAddress