Range.Select 1st pass 13 cols, 2nd paqss 25 cols twice as wide in error?

[Craigm]

I am setting up a blank table months Jan through Dec wide and years 2004
through 2010 high.

I am trying to slect an area 9 rows high by 13 columns wide to clear
and establish the table. The range used to call the fuction is
"Range("A8")". The function variable is defined as "rRange As Range"

When I run the line of code below, the first time it executes it
selects the correct area.

Range(rRange, rRange.Offset(8, 12)).Select

Every time after that, with the same range passed in, it selects an
area 9 rows high and 25 columns wide. Twice as wide as during the
first pass.

It repeats this behavior until I manually delete the area of the
worksheet. Then it works correctly again the first time and reverts to
selecting 25 columns wide every time it is run after that.

Does the range somehow hold it's previous setting? If it dis that I
would expect the region selected to grow by 12 columns every time it is
run but it doesn't behave that way.

-----------------------
The full function call is:

Set rReturnedRange = Create_Year_Month_Table("Chart Data", Range("A8"),
8, 1, 36, 1, "Monthly Mileage")

-----------------
The full fuction is:

Function Create_Year_Month_Table(sSheet As String, rRange As Range,
iBoarderColor As Integer, iBorderFontColor, iCellColor As Integer,
iCellFontColor As Integer, Chart_Title As String) As Range

Dim i As Integer

Dim lCol As Long
Dim lRow As Long

Dim lLastFromRow As Long
Dim lLastToRow As Long

Dim rPlace1 As Range
Dim rPlace2 As Range
Dim rPlace3 As Range

Dim sTopLeft As String

Application.DisplayAlerts = False

sRange = rRange.Address
sTopLeft = rRange.Address

Temp = Val(sTopLeft)

aMonths = Array("Jan", "Feb", "Mar", "Apr", "May", "June", "July",
"Aug", "Sept", "Oct", "Nov", "Dec")
aYears = Array("2004", "2005", "2006", "2007", "2008", "2009",
"2010")

Sheets(sSheet).Select

Range(rRange, rRange.Offset(8, 12)).Select
With Selection
..MergeCells = False
..ClearContents 'Clear the entire
worksheet
'.Interior.ColorIndex = xlNone 'Clear all cell
colors
..NumberFormat = "General" 'Set General as the
format for all cells
..Font.Bold = False 'Bold Off
..Font.Italic = False 'Italics off
..Font.Underline = xlUnderlineStyleNone 'No underlines
..Font.ColorIndex = iCellFontColor 'Font color set to
automatic (black)
..Interior.ColorIndex = iCellColor 'Interior of cell
color

..Borders(xlDiagonalDown).LineStyle = xlNone
..Borders(xlDiagonalUp).LineStyle = xlNone

..Borders(xlEdgeLeft).LineStyle = xlNone
'xlContinuous
'.Borders(xlEdgeLeft).Weight = xlNone
'xlThin
'.Borders(xlEdgeLeft).ColorIndex = xlNone
'xlAutomatic

..Borders(xlEdgeTop).LineStyle = xlNone
'xlContinuous
'.Borders(xlEdgeTop).Weight = xlNone
'xlThin
'.Borders(xlEdgeTop).ColorIndex = xlNone
'xlAutomatic

..Borders(xlEdgeBottom).LineStyle = xlNone
'xlContinuous
'.Borders(xlEdgeBottom).Weight = xlNone
'xlThin
'.Borders(xlEdgeBottom).ColorIndex = xlNone
'xlAutomatic

..Borders(xlEdgeRight).LineStyle = xlNone
'xlContinuous
'.Borders(xlEdgeRight).Weight = xlNone
'xlThin
'.Borders(xlEdgeRight).ColorIndex = xlNone
'xlAutomatic

..Borders(xlInsideVertical).LineStyle = xlNone
'xlContinuous
'.Borders(xlInsideVertical).Weight = xlNone
'xlThin
'.Borders(xlInsideVertical).ColorIndex = xlNone
'xlAutomatic

..Borders(xlInsideHorizontal).LineStyle = xlNone
'xlContinuous
'.Borders(xlInsideHorizontal).Weight = xlNone
'xlThin
'.Borders(xlInsideHorizontal).ColorIndex = xlNone
'xlAutomatic

End With

Set rPlace2 = rRange.Offset(2, 1) 'The position
to be passed out of the function

Set rPlace1 = rRange.Resize(1, 13) 'Title Row to
be merged

rPlace1.Select

With Selection
..Value = Chart_Title
..Font.Bold = True
..Interior.ColorIndex = iBoarderColor
..HorizontalAlignment = xlCenter
..VerticalAlignment = xlBottom
..WrapText = False
..Orientation = 0
..AddIndent = False
..IndentLevel = 0
..ShrinkToFit = False
..ReadingOrder = xlContext
..MergeCells = True

..Borders(xlDiagonalDown).LineStyle = xlNone
..Borders(xlDiagonalUp).LineStyle = xlNone
..Borders(xlEdgeLeft).LineStyle = xlNone
..Borders(xlEdgeTop).LineStyle = xlNone
..Borders(xlEdgeBottom).LineStyle = xlNone
..Borders(xlEdgeRight).LineStyle = xlNone
..Borders(xlInsideVertical).LineStyle = xlNone
..Borders(xlInsideHorizontal).LineStyle = xlNone
End With



With Selection.Interior
..ColorIndex = iBoarderColor
..Pattern = xlSolid
..PatternColorIndex = xlAutomatic
End With

'Selection.Value = Chart_Title

ActiveCell.Offset(1, 0).Select 'Move Active Cell down 1 row
Selection.Interior.ColorIndex = iBoarderColor

Temp = Selection.Address(ReferenceStyle:=xlR1C1) 'R15C1

lRow = Val(Mid(Temp, 2, Len(Temp) - (InStr(1, Temp, "C") - InStr(1,
Temp, "R")))) '15 correct
lCol = Val(Right(Temp, Len(Temp) - InStr(1, Temp, "C")))

i = 0
For lCol = lCol + 1 To lCol + 12 'Run Months
horizontally
Cells(lRow, lCol) = aMonths(i)
Cells(lRow, lCol).Select
With Selection
..Font.Color = iBorderFontColor
..Interior.ColorIndex = iBoarderColor
..Font.Bold = True
..HorizontalAlignment = xlCenter

..Borders(xlDiagonalDown).LineStyle = xlNone
..Borders(xlDiagonalUp).LineStyle = xlNone
..Borders(xlEdgeLeft).LineStyle = xlNone
..Borders(xlEdgeTop).LineStyle = xlNone
'.Borders(xlEdgeBottom).LineStyle = xlAutomatic
'xlNone
..Borders(xlEdgeRight).LineStyle = xlNone
..Borders(xlInsideVertical).LineStyle = xlNone
..Borders(xlInsideHorizontal).LineStyle = xlNone
End With
i = i + 1
Next lCol
''Dec selected
lRow = Val(Mid(Temp, 2, Len(Temp) - (InStr(1, Temp, "C") - InStr(1,
Temp, "R"))))
lCol = Val(Right(Temp, Len(Temp) - InStr(1, Temp, "C")))
'''(5,3)
i = 0
For lRow = lRow + 1 To lRow + 7 'Run years
Vertically
Cells(lRow, lCol) = aYears(i)

Cells(lRow, lCol).Select
With Selection
..Font.Color = iBorderFontColor
..Interior.ColorIndex = iBoarderColor
..Font.Bold = True
..HorizontalAlignment = xlCenter

..Borders(xlDiagonalDown).LineStyle = xlNone
..Borders(xlDiagonalUp).LineStyle = xlNone
..Borders(xlEdgeLeft).LineStyle = xlNone
..Borders(xlEdgeTop).LineStyle = xlNone
..Borders(xlEdgeBottom).LineStyle = xlNone
'.Borders(xlEdgeRight).LineStyle = xlAutomatic
'xlNone
..Borders(xlInsideVertical).LineStyle = xlNone
..Borders(xlInsideHorizontal).LineStyle = xlNone
End With
i = i + 1
Next lRow
'2010
rPlace2.Select
'Create_Year_Month_Table = rRange.Offset(1, 1)
'ActiveCell = rPlace2.Address

'Dim cell As Range
'store the active cell in a variable
'Set cell = ActiveCell
Application.DisplayAlerts = True

Set Create_Year_Month_Table = rPlace2 '(ActiveRegion)
'rRange.Offset(1, 1) '= rRange.Address"rRange.Address"
'End Sub
End Function


Thanks for your help. I cannot break this code. It seems to defy
logic.

Craigm

 

[Guest]

I suspect if you don't merge the cells, you won't have the problem.

 

[Craigm]

I added

rRange.Select
With Selection
..MergeCells = False
End With

As the first executable line. THe only cell that could affect this was
the corner cell that was passed into the function. If that cell was
merged it gave the expanded column selection.

I had moved the resize and offset commands after the unmerging as an
attempt to avoid the extra coloumn selection problem. That was not
enought.

So I added the four lines above and the problem seems to have corrected
itself.

Thanks for your help.