OK, my mistake was to widen column A.
This can be off the screen and then it won't work.
This code works reasonably well:

Sub TopRightAlignRange(rngRange As Range)

Dim bError As Boolean
Dim lRangeRightCol As Long
Dim lVisibleRangeRightCol As Long
Dim bAdjustWidth As Boolean
Dim rngVis As Range
Dim lColBefore As Long

Application.ScreenUpdating = False

On Error Resume Next

'top align top row of range
'--------------------------
ActiveWindow.ScrollRow = rngRange.Cells(1).Row

Set rngVis = ActiveWindow.VisibleRange

'this is the right-most column of the passed range
'-------------------------------------------------
lRangeRightCol = rngRange.Cells(rngRange.Cells(1).Row, _
rngRange.Columns.count).Column

'this is the column before the passed range
'------------------------------------------
lColBefore = rngRange.Cells(1).Column - 1

lVisibleRangeRightCol = _
rngVis.Cells(rngVis.Cells(1).Row, _
rngVis.Columns.count).Column


If lRangeRightCol = rngVis.Cells(rngVis.Cells(1).Row, _
rngVis.Columns.count).Column Then
Exit Sub
End If

If lRangeRightCol < lVisibleRangeRightCol Then
'first try left scroll to align right side of range to right screen
edge
'-----------------------------------------------------------------------
Do Until lRangeRightCol = _
rngVis.Cells(rngVis.Cells(1).Row, _
rngVis.Columns.count).Column Or _
lRangeRightCol _
rngVis.Cells(rngVis.Cells(1).Row, _
rngVis.Columns.count).Column Or _
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll ToLeft:=1
Set rngVis = ActiveWindow.VisibleRange
If Err.Number < 0 Then
bError = True
Exit Do
End If

If lRangeRightCol _
rngVis.Cells(rngVis.Cells(1).Row, _
rngVis.Columns.count).Column Then
ActiveWindow.SmallScroll ToRight:=1
Set rngVis = ActiveWindow.VisibleRange
bAdjustWidth = True
Exit Do
End If
Loop
Else
'first try right scroll to align right side of range to right screen
edge
'-----------------------------------------------------------------------
Do Until lRangeRightCol = _
rngVis.Cells(rngVis.Cells(1).Row, _
rngVis.Columns.count).Column Or _
lRangeRightCol < _
rngVis.Cells(rngVis.Cells(1).Row, _
rngVis.Columns.count).Column
ActiveWindow.SmallScroll ToRight:=1
Set rngVis = ActiveWindow.VisibleRange
If Err.Number < 0 Then
bError = True
On Error GoTo 0
Exit Do
End If
If lRangeRightCol < _
rngVis.Cells(rngVis.Cells(1).Row, _
rngVis.Columns.count).Column Then
bAdjustWidth = True
Exit Do
End If
Loop
End If

If bError Or _
lRangeRightCol < _
rngVis.Cells(rngVis.Cells(1).Row, _
rngVis.Columns.count).Column Then
If lRangeRightCol < rngVis.Cells(rngVis.Cells(1).Row, _
rngVis.Columns.count).Column Then

Do While lRangeRightCol < _
rngVis.Cells(rngVis.Cells(1).Row, _
rngVis.Columns.count).Column
Columns(lColBefore).ColumnWidth =
Columns(lColBefore).ColumnWidth + 1
Set rngVis = ActiveWindow.VisibleRange
DoEvents
Loop
Columns(lColBefore).ColumnWidth =
Columns(lColBefore).ColumnWidth - 1
Else
Do While lRangeRightCol _
rngVis.Cells(rngVis.Cells(1).Row, _
rngVis.Columns.count).Column
Columns(lColBefore).ColumnWidth =
Columns(lColBefore).ColumnWidth - 1
Set rngVis = ActiveWindow.VisibleRange
DoEvents
Loop
End If
End If

On Error GoTo 0

Application.ScreenUpdating = True

End Sub


Still, I suspect somehow that there must be a simpler way to do this.


RBS


"RB Smissaert" wrote in message
...
Trying to figure out a way to push a selected range against the right edge
of the screen by inreasing the width of column A.
It thought a loop like this would do it:

Do Until lRangeRightCol _
rngVis.Cells(rngVis.Cells(1).Row, _
rngVis.Columns.count).Column
Columns(1).ColumnWidth = Columns(1).ColumnWidth + 1
Set rngVis = ActiveWindow.VisibleRange
DoEvents
Loop

Where lRangeRightCol is the right-most column of this range.
However it doesn't work. Column A gets wider and wider, but the loop
doesn't exit.
Updating the screen doesn't help or more precisely doing
Application.ScreenUpdating = True
doesn't update the screen and maybe that is the trouble.

Any suggestions how to do this?

RBS