That was indeed your code, thanks, and it is still working fine for me.
This is a similar situation (re pages), but where the user has used a
routine to insert a page into the sheet.....I now need to revise the
Collection page(s) at the end of the sheet.
I'm trying to find where the first Collection page starts, and if there
are subsequent Collection pages, how many.
As before, each page starts with "Item" in Col1.
If it's the initial Collection page, then an offset from "Item"
Offset(1, 1).End(xlDown).Value should return "COLLECTION".
If it's a subsequent Collection then it'll be "COLLECTION (Cont.)".
Any other value should mean a normal data page.
In my test sheet I had "Item" in A1, A55, A114, A173.
I had "COLLECTION" in B58, and "COLLECTION (Cont.)"
in B117 and B176. To mark the end of the sheet, I used "£" in
F231.
Sub TestArray()
Dim C As Range, TargetCell As String
Dim myRng As Range, £Col As Integer
Dim LastRw As Long, ws As Worksheet
Dim StartRw As Long
Dim varr()
£Col = 6
Set ws = ActiveSheet
With ws
Set myRng = (.Cells(65536, £Col).End(xlUp) _
.Offset(0, -(£Col - 1)))
myRng.Select
LastRw = myRng.Row
ReDim varr(1 To 1)
Do 'Until
TargetCell = .Columns(1).Find(What:="Item", _
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Select
If ActiveCell.Offset(1, 1).End(xlDown).Value _
= "COLLECTION" Then
'it should mean only one Collection page
StartRw = ActiveCell.Offset(1, 1) _
.End(xlDown).Row + 2
If IsEmpty(varr(1)) Then
Set varr(1) = .Range("B" & StartRw)
Else
ReDim Preserve varr(1 To UBound(varr) + 1)
Set varr(UBound(varr)) = .Range("B" & StartRw)
End If
ElseIf ActiveCell.Offset(1, 1).End(xlDown).Value = _
"COLLECTION (Cont.)" Then
'it should mean multiple Collections
StartRw = ActiveCell.Offset(1, 1) _
.End(xlDown).Row + 2
If IsEmpty(varr(1)) Then
Set varr(1) = .Range("B" & StartRw)
Else
ReDim Preserve varr(1 To UBound(varr) + 1)
Set varr(UBound(varr)) = .Range("B" & StartRw)
End If
ElseIf ActiveCell.Row = 1 Then
Exit Do
End If
Loop
End With
End Sub
For me it seems to overwrite varr(1) rather than increment the
array.....and I don't know why.
Any help much appreciated.
Regards.