View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default Defining Range using Cells

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