Page location VBA

rjplante

rjplante

Well-known Member
Joined
Oct 31, 2008
Messages
574
Office Version
  1. 365
Platform
  1. Windows
I would like to have the workbook scroll to the Left most column and top most row so that cell A1 is visible. I don't want to select a cell by using Range("A1").select, I just want to "scroll" to this area so that A1 is visible.

Could someone send me the code to do this.

Thanks,

Robert
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Sort by date Sort by votes
The following will scroll all sheets to the sheet origin. It will break down if you have a chart object selected when trying to run this, but otherwise will work fine

Code: 
Sub ScrollAllSheetsTopLeft()
'Scrolls to topleft of all sheets
'Dimension variables
Dim sht As Worksheet
Dim shtActiveSht As Worksheet
'Determine the activesheet at start of code execution
Set shtActiveSht = ActiveSheet
'stop screen updates as code iterates sheets (Stops screen flashing)
With Application
    .ScreenUpdating = False
'iterate sheets moving the activewindow each time to row 1, column 1
    For Each sht In ActiveWorkbook.Worksheets
    sht.Activate
        With ActiveWindow
            .ScrollColumn = 1
            .ScrollRow = 1
        End With
'select top left cell on each sheet
    Range("A1").Select
    Next sht
'activate original starting sheet
shtActiveSht.Activate
'Turn screen updates back on
    .ScreenUpdating = True
End With
End Sub
 
Upvote 0
Thanks!! This is awesome! Just what the excel junkie ordered.

Robert
 
Upvote 0
Run Time error

I have a macro that is called from another macro that when it runs I get the following error message:

Run-Time error '1004':

Unable to set the Visible property of the Worksheet class

Then it flags the line in red below:

The macro runs, brings me to the main page, hides the other worksheets, and completes everything else written, and then it flags the error. I don't know what to look for or how to resolve it.

Thanks in advance for any help with this bug, I mean design feature!

Robert
-----------------------------------------

Code: 
Sub Intro_page()

Application.ScreenUpdating = False

On Error Resume Next
For Each s In Worksheets
    [COLOR=Red]s.Visible = False[/COLOR]
    If s.Name = "Intro Page" Then s.Visible = True
Next s

Sheets("Intro Page").Activate
    With ActiveWindow
        .ScrollColumn = 1
        .ScrollRow = 1
    End With

ActiveWorkbook.Save

Application.ScreenUpdating = True

End Sub
[\code]


The above macro gets called from this macro.

[code]
Sub MSTS_UPDATE_CHECK_EXIT()

'Check to see if main field says 'YES' and Line # is Blank

If Range("BE7").Value = "YES" And Range("BE5") = "" Then
Call MSTS_MAIN_Update
End If

If Range("BE14").Value = "YES" And Range("BF14") = "" Then
Call MSTS_T12_Update
End If

If Range("BE15").Value = "YES" And Range("BF15") = "" Then
Call MSTS_T18_Update
End If

If Range("BE16").Value = "YES" And Range("BF16") = "" Then
Call MSTS_T24_Update
End If

Call Intro_page

End Sub
[\code]

The other macros listed appear below.
[code]
Sub MSTS_MAIN_Update()

'   Ask user if they want to update the Master Stability Tracking Sheet.

Application.EnableEvents = False

i = MsgBox("Do you want to update the Master Stability Tracking Sheet?", vbYesNo + vbExclamation + vbDefaultButton2)

If i = 7 Then 'NO
Application.EnableEvents = True
Application.ScreenUpdating = True
Call Intro_page
Exit Sub

ElseIf i = 6 Then 'YES
Application.ScreenUpdating = False

File1 = ActiveWorkbook.Name 'defines the current workbook name as File1

Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BD11:BO11").Copy

'open Master Stability Tracking Sheet workbook

ChDir "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data"
Workbooks.Open Filename:= _
    "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data\Master Stability Tracking Sheet.xlsm"

'   Check to see if first row is blank and if it is paste data in first row.

If Range("B4").Value = "" Then
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False

'   If first row is not blank, go to the first empty row.

Else
Range("B3").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False

End If

'   transfer row number back to the main workbook.

Range("B3").End(xlDown).Offset(0, -1).Copy 'From MSTS trendline workbook

With Workbooks(File1)
    .Sheets("QC5003.8 PCB Stab Rec - Storage").Visible = True
    .Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BE5").PasteSpecial Paste:=xlPasteValues
End With

ActiveWorkbook.Save
ActiveWorkbook.Close    ' close MSTS workbook

Workbooks(File1).Activate

'   record the date MSTS was updated.

Sheets("QC5003.8 PCB Stab Rec - Storage").Range("AH31").Value = Date
Sheets("QC5003.8 PCB Stab Rec - Storage").Visible = False

Application.EnableEvents = True
Application.ScreenUpdating = True

Call Intro_page

MsgBox "Data transfer is complete."

End If

End Sub

Sub MSTS_T12_Update()

Application.ScreenUpdating = False

File1 = ActiveWorkbook.Name

ChDir "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data"
Workbooks.Open Filename:= _
    "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data\Master Stability Tracking Sheet.xlsm"
Range("Z1").ClearContents

Workbooks(File1).Activate

Sheets("QC5003.8 PCB Stab Rec - Storage").Visible = True
Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BE5").Copy

Application.ScreenUpdating = True
Workbooks("Master Stability Tracking Sheet.xlsm").Activate
Application.ScreenUpdating = False
Sheets("Stability").Range("Z1").PasteSpecial Paste:=xlPasteValues

'Loop to find row
Range("A3").Select

Do

If ActiveCell.Value <> Range("Z1").Value Then
Selection.Offset(1, 0).Select
End If

Loop Until ActiveCell.Value = Range("Z1").Value

ActiveCell.Offset(0, 13).Select
ActiveCell.Value = Date

ActiveWorkbook.Save
ActiveWorkbook.Close

Workbooks(File1).Activate

Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BF14").Value = Date

Application.ScreenUpdating = True

Call Intro_page

End Sub

Sub MSTS_T18_Update()

Application.ScreenUpdating = False

File1 = ActiveWorkbook.Name

ChDir "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data"
Workbooks.Open Filename:= _
    "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data\Master Stability Tracking Sheet.xlsm"
Range("Z1").ClearContents

Workbooks(File1).Activate

Sheets("QC5003.8 PCB Stab Rec - Storage").Visible = True
Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BE5").Copy

Application.ScreenUpdating = True
Workbooks("Master Stability Tracking Sheet.xlsm").Activate
Application.ScreenUpdating = False
Sheets("Stability").Range("Z1").PasteSpecial Paste:=xlPasteValues

'Loop to find row
Range("A3").Select

Do

If ActiveCell.Value <> Range("Z1").Value Then
Selection.Offset(1, 0).Select
End If

Loop Until ActiveCell.Value = Range("Z1").Value

ActiveCell.Offset(0, 14).Select
ActiveCell.Value = Date

ActiveWorkbook.Save
ActiveWorkbook.Close

Workbooks(File1).Activate

Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BF15").Value = Date

Application.ScreenUpdating = True

Call Intro_page

End Sub

Sub MSTS_T24_Update()

Application.ScreenUpdating = False

File1 = ActiveWorkbook.Name

ChDir "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data"
Workbooks.Open Filename:= _
    "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data\Master Stability Tracking Sheet.xlsm"
Range("Z1").ClearContents

Workbooks(File1).Activate

Sheets("QC5003.8 PCB Stab Rec - Storage").Visible = True
Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BE5").Copy

Application.ScreenUpdating = True
Workbooks("Master Stability Tracking Sheet.xlsm").Activate
Application.ScreenUpdating = False
Sheets("Stability").Range("Z1").PasteSpecial Paste:=xlPasteValues

'Loop to find row
Range("A3").Select

Do

If ActiveCell.Value <> Range("Z1").Value Then
Selection.Offset(1, 0).Select
End If

Loop Until ActiveCell.Value = Range("Z1").Value

ActiveCell.Offset(0, 15).Select
ActiveCell.Value = Date

ActiveWorkbook.Save
ActiveWorkbook.Close

Workbooks(File1).Activate

Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BF16").Value = Date

Application.ScreenUpdating = True

Call Intro_page

End Sub
[\code]
 
Upvote 0
Hi Robert,
Try this more safety Intro_page code (see the reason in comments):
Rich (BB code): 

Sub Intro_page()

  Dim s As Worksheet
  
  Application.ScreenUpdating = False
  
  ' Firstly make Intro Page visible!
  With Sheets("Intro Page")
    .Visible = True
    .Activate
  End With
  
  ' Set scrolling
  With ActiveWindow
    .ScrollColumn = 1
    .ScrollRow = 1
  End With
  
  ' Hide other sheets.
  ' It is guaranteed now that at least one sheet is always visible,
  ' therefore error (trying to hide all sheets) will not happen
  For Each s In Worksheets
    If StrComp(s.Name, "Intro Page", vbTextCompare) <> 0 Then
      s.Visible = xlSheetVeryHidden  ' or = xlSheetHidden
    End If
  Next s

  ' Save Wb
  ActiveWorkbook.Save

  Application.ScreenUpdating = True

End Sub
Regards,
Vlad
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Locking cells in place?
Replies
3
Views
90
Peter_SSs
Peter_SSs
J
  • Solved
Alternative to Find Select Box
Replies
3
Views
90
JGOpsMgr
J
F
  • Question Question
Positioning a userform to a cell
Replies
4
Views
91
fraz627
F
H
  • Question Question
VBA Pivot Table Dynamic Range & Only One Selection per Row
Replies
3
Views
280
DanteAmor
DanteAmor
D
  • Question Question
Choose from List Box
Replies
5
Views
160
ddnron
D

Forum statistics

Threads
1,224,552
Messages
6,179,486
Members
452,917
Latest member
MrsMSalt

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top