Sub ABC()
Dim rng As Range, cell As Range, ar As Range
Dim rng1 as Range, rng2 as Range
Dim x as Long, y as Long, m as Long
' 1) Defines first row and column
set rng1 = Cells.Find(What:="ACTUALS", _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
m = rng1.Column
x = rng1.Row
'2) Defines last row
set rng2 = Cells.Find(What:="FORECAST", _
After:=rng1, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
y = rng2.row
Set rng = Range(Cells(x,m),Cells(y,m)).SpecialCells(xlConsta nts)
For Each ar In rng.Areas
For Each cell In ar
If cell.Row < ar(1).Row Then
cell.Offset(0, 1).Value = ar(1).Value
End If
Next cell
ar(1).ClearContents
Next ar
End Sub
However, if you have Forecast and Actuals in the data range, then that
doesn't reflect your original sample and the code I provided was set up for
your example. Perhaps you want
x = rng1.Row + 1
. . .
y = rng2.row - 1
so those values are excluded. I can't say definitively since I don't know
how your data is laid out.
--
Regards,
Tom Ogilvy
"T De Villiers"
wrote in message
news:T.De.Villiers.2br9n2_1154258105.4327@excelfor um-nospam.com...
I am having problems with the asterixed row, cant seem to define the
range
using the cells object.
Many Thanks
Sub ABC()
Dim rng As Range, cell As Range, ar As Range
' 1) Defines first row and column
Cells.Find(What:="ACTUALS", After:=ActiveCell, LookIn:=xlValues, LookAt
_
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Activecell.column = m
Activecell.row = x
'2) Defines last row
Cells.Find(What:="FORECAST", After:=ActiveCell, LookIn:=xlValues,
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Activecell.row = y
**Set rng = (Cells(x,m),Cells(y,m)).SpecialCells(xlConstants)
For Each ar In rng.Areas
For Each cell In ar
If cell.Row < ar(1).Row Then
cell.Offset(0, 1).Value = ar(1).Value
End If
Next cell
ar(1).ClearContents
Next ar
End Sub
--
T De Villiers
------------------------------------------------------------------------
T De Villiers's Profile:
http://www.excelforum.com/member.php...o&userid=26479
View this thread: http://www.excelforum.com/showthread...hreadid=566385