I'm currently trying to put together some VBA in excel. Not overly familiar, but have managed to collate the following;
Sub PasteBOMLines()
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Set up loop
Dim loopCount As Integer 'Number of cycles to complete
Dim loopCountNow As Integer 'Number of cycles completed so far
loopCount = Range("B4") 'Get number of cycles to complete from cell
loopCountNow = 0 'Set current number of loops to 0
Range("B6:N24").Select
Selection.Copy
Do While loopCount > loopCountNow 'Start of loop, continue looping until the number of loops completed is equal to number of loops to complete
'Paste and Group the relevant cell
ActiveCell.Offset(19, 0).Range("A1:M19").Select
ActiveSheet.Paste
ActiveCell.Offset(3, 0).Range("A1:F16").Select
Selection.Rows.Group
'Resolves loop
loopCountNow = loopCountNow + 1 'integer loops completed by 1
Loop 'returns code to the "do while" bit
'Change settings to default
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub
I'm having issues getting the grouping bit to work. If I leave out this bit;
ActiveCell.Offset(3, 0).Range("A1:F16").Select
Selection.Rows.Group
The copy/paste function works fine, but once added in, the first copy/paste will group, then I get this error;
"Paste method of Worksheet class failed"
Any ideas? Thank you
Background: This project is gets loaded into full screen maximized.To make it look good I took out the tabs, formula bar, headers and status bar. I created my own buttons customized from shapes. These do have some very attractive colors and 3D views and I am wondering it is my code or the shapes that cause it to load slowly. When I Click a button to change pages is when this happens. Initially I had the button macros simply changing the pages but I thought it was slow because i was using select code. worksheet.Activate and worksheets.range.select. And the code was in the worksheet private sub under the Activate event. Then I took the code from there removed the select criteria and it almost feels slower. Is there anything I can do to pick up speed? Thank you.
This Example shows how the buttons are positioned up top of each worksheet. There are 10 sheets with these buttons which are shapes.
Example of 1 worksheet with Navigation Buttons on top
Here is the code im using now. This code is in public subs for a general module.
Sub StartPg()
'ChangePagesmacro
With wsStart.Application 'initiate page loading
.Calculation = xlCalculationManual 'turn off calculations
.ScreenUpdating = False 'turn off screen updates
.EnableEvents = False 'disable events
.Goto Reference:=wsStart.Range("A4"), Scroll:=True 'page starting point
With .ActiveWindow
If .FreezePanes Then .FreezePanes = False 'unfreeze panes to remove any jam up`enter code here`
.SplitColumn = 0 'unsplit column to free up screen
.SplitRow = 0 'unsplit row to free up screen
.WindowState = xlMaximized 'maximize window
.DisplayHeadings = False 'turn of page headings
.DisplayFormulas = False ' hide formula bar
.DisplayWorkbookTabs = False 'hide page tabs
.DisplayGridlines = False 'hide gridlines
.DisplayHorizontalScrollBar = True 'show scrollbar
.DisplayVerticalScrollBar = True 'show scrollbar
.Zoom = 81 'zoom and area
.ScrollColumn = 1 'scroll to top
.ScrollRow = 1 'scroll to left
.SplitColumn = 0 'split colum to be frozen
.SplitRow = 3 'split row to be frozen
.FreezePanes = True 'freeze panes
End With
End With
With wsStart
.ScrollArea = "SAStart" 'set user scroll area
With .Application
.Calculation = xlCalculationAutomatic 'turn on calculations
.ScreenUpdating = True ' turn on screen updates
.EnableEvents = True ' turn on events
.DisplayFormulaBar = False 'No formula bar
.DisplayStatusBar = False 'No status bar
.DisplayFullScreen = True ' show full screen
End With
End With
End Sub
This is my second post about this macro. Although the first post received a few responses, none of the responses solved the problem (thank you for responding though).
Scenario:
I have about 20 sub-spreadsheets with links to external sources. The number of links per spreadsheet varies from about 500 to 10,000. A master spreadsheet calls macros to open each sub-spreadsheet in turn and update the links.
Each sub-spreadsheet has a dashboard that tells me how many links remain to be updated. This is done by counting the number of “N/A” values in each tab, then summing these counts in cell A20. As the links are updated, the value in A20 counts down to zero.
Sub Sub01()
Dim NAtotal As Integer
Set ActiveWKB = Workbooks.Open("Sub01.xlsm")
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.CalculateFull
ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources
NAtotal = Worksheets("Dashboard").Cells(20, "C").Value
MsgBox (NAtotal) 'Tells me how many cells remain to be updated – starts off at 4450.
NAtotal = 100 'Debugging effort to let me know that NAtotal does adjust.
MsgBox (NAtotal)
Do Until NAtotal = 0
Application.ScreenUpdating = True
MsgBox (NAtotal) 'Another debugging effort to monitor NAtotal. Starts at 100, then jumps to (and remains at) 4450 on the second loop and all subsequent loops.
NAtotal = Worksheets("Dashboard").Cells(20, "C").Value 'Resets NAtotal to the value in C20. This never changes, but remains at 4450.
DoEvents
Loop
Application.Calculation = xlManual
MsgBox ("Done")
Sheets("Dashboard").Activate
Range("B1").Select
ActiveWorkbook.Save
ActiveWindow.Close
End Sub`
The macro should continue to loop until cell A20 hits zero, and then stop.
Cell A20 does count down, but variable NAtotal remains at its initial value.
Any guidance/recommendations are appreciated.
Hi the code below worked for me. Try use the same method instead of using a loop. The schedule will trigger every second until the NATotal = 0 logically anyway. Just update the code to fit your references.
Public firstOpen As Boolean
Sub testForm()
Dim cellCount As Integer
Dim s1 As Sheet1
Set s1 = Sheet1
Dim cellCol As Integer
Dim activeWbk As Workbook
Dim ws As Worksheet
If firstOpen = False Then
firstOpen = True
Set activeWbk = Workbooks.Open("C:\Example\Link2.xlsm")
Set ws = activeWbk.Sheets("Sheet1")
Application.Calculation = xlCalculationAutomatic
Application.CalculateFull
activeWbk.UpdateLink Name:=ActiveWorkbook.LinkSources
CreateNewSchedule
Exit Sub
Else
Set activeWbk = Workbooks("Link2.xlsm")
Set ws = activeWbk.Worksheets("Sheet1")
End If
cellCount = ws.Range("N2").Value
If cellCount = 0 Then
MsgBox ("Done...")
Application.Calculation = xlCalculationManual
firstOpen = false
Else
Debug.Print cellCount
CreateNewSchedule
End If
'Application.Calculation = xlCalculationManual
End Sub
Sub CreateNewSchedule()
Application.OnTime Now + TimeValue("00:00:01"), Procedure:="testForm", Schedule:=True
End Sub
I have a VBA script in Excel that freezes the panes of an Excel worksheet, but I'm curious to see if this is possible without first selecting a range. This is my current code which freezes rows 1–7 but uses Range.Select:
ActiveSheet.Range("A8").Select
ActiveWindow.FreezePanes = True
Any suggestions?
Record yourself using the View ► Freeze Panes ► Freeze Top Row command and this is what you get for .FreezePanes.
With ActiveWindow
If .FreezePanes Then .FreezePanes = False
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
So modifying the .SplitColumn and/or .SplitRow properties should do it for you regardless on what the ActiveCell property is.
There are many things to get wrong about freezing panes. I add my own answer, so I will find it here, and won't have to reinvent it next time.
Public Sub FreezePanesAt(rngDataTopLeft As Range)
Dim wndCurrent As Window
For Each wndCurrent In rngDataTopLeft.Worksheet.Parent.Windows
With wndCurrent
.FreezePanes = False
If Not ((rngDataTopLeft.Row = 1) And (rngDataTopLeft.Column = 1)) Then
.ScrollRow = 1
.ScrollColumn = 1
.SplitRow = rngDataTopLeft.Row - 1
.SplitColumn = rngDataTopLeft.Column - 1
.FreezePanes = True
End If
End With
Next
End Sub
Example usage:
FreezePanesAt ThisWorkbook.Worksheets("Sheet1").Range("B3")
FreezePanesAt ThisWorkbook.Names("Header").RefersToRange
The input parameter is the top left cell of the bottom right pane; I think this is the most frequent use case: you know the range at which to split and don't care about which workbook / worksheet / window it is in
If the input parameter is in the first row / first cell but not A1, then there will be only two panes; A1 is a special case, however, Excel would split the window at center of the current view, I prevented this because I can't think of any case where this would be intended
It iterates through all Windows attached to the workbook / worksheet; indexing into Application.Windows (Windows(Thisworkbook.Name)) won't cause an error if you have more windows to the same workbook (the name would be "MyWorkbook:1"), or Excel attempted (which usually fails) to repair a workbook after a crash (the name would be "MyWorkbook [Repaired]")
It takes into consideration that panes may already be frozen and the user / another macro might have scrolled to a location in the workbook, and the top left cell in the window is not A1
I found the previous answers only worked with some sheets when looping through tabs. I found the following code worked on every tab I looped through (target was a single workbook), despite which workbook was the activeworkbook.
The short of it:
With Application.Windows(DataWKB.Name)
Application.Goto ws.Cells(4, 5)
.SplitColumn = 4
.SplitRow = 3
.FreezePanes = True
End With
The code as it is in my Sub: (be aware, I do a lot more formatting in this sub, I tried to strip that out and leave just the code needed here)
Sub Format_Final_Report()
Dim DataWKB As Workbook
Set DataWKB = Workbooks("Report.xlsx")
Dim ws As Worksheet
Dim tabCNT As Long
Dim tabName As String
tabCNT = DataWKB.Sheets.Count
For i = 1 To tabCNT
Set ws = DataWKB.Worksheets(i)
tabName = ws.Name
With Application.Windows(DataWKB.Name)
Application.Goto ws.Cells(4, 5)
.SplitColumn = 4
.SplitRow = 3
.FreezePanes = True
End With
Next i
End Sub
Hopefully, this will save someone some research time in the future.
I need to be able to properly refreeze panes (when creating new windows, notably) without losing the activecell or messing up the visible range. It took a lot of playing around but I think I have something solid that works:
Sub FreezePanes(nbLignes As Integer, nbColonnes As Integer, Optional ByVal feuille As Worksheet)
If feuille Is Nothing Then Set feuille = ActiveSheet Else feuille.Activate
Error GoTo erreur
With ActiveWindow
If .View = xlNormalView Then
If .FreezePanes Then .FreezePanes = False
If .Split Then .Split = False
.SplitColumn = nbColonnes
.SplitRow = nbLignes
If .Panes.Count = 4 Then 'rows and columns frozen
.Panes(1).ScrollRow = 1
.Panes(1).ScrollColumn = 1
.Panes(2).ScrollRow = 1 'top right pane
.Panes(3).ScrollColumn = 1 'bottom left pane
ElseIf nbLignes > 0 Then .Panes(1).ScrollRow = 1
ElseIf nbColonnes > 0 Then .Panes(1).ScrollColumn = 1
Else: GoTo erreur
End If
.FreezePanes = True
End If
End With
Exit Sub
erreur:
Debug.print "Erreur en exécutant le sub 'FreezePanes " & nbLignes & ", " & nbColonnes & ", '" & feuille.Name & "' : code #" & Err.Number & Err.Description
End Sub
I know this is old but I came across this tidbit that may be useful...
as ChrisB stated, the SplitColumn/SplitRow values represent the last cell above/left of the split BUT of the currently visible window. So if you happen to have code like this:
Application.Goto Worksheets(2).Range("A101"), True
With ActiveWindow
.SplitColumn = 0
.SplitRow = 10
.FreezePanes = True
End With
The split will be between rows 110 and 111 instead of 10 and 11.
edited for clarification and to add more information:
My point is that the values are offsets of the upper left cell, not an address of a cell. Therefore, ChrisB's Dec 4 '15 at 18:34 comment under the main answer only holds if row 1 is visible in the Activewindow.
A couple of other points on this:
using Application.goto doesn't necessarily put whichever cell you
are trying to go to in the upper left
the cell that is put in the upper left when using .goto can depend
on the size of the excel window, the current zoom level, etc (so fairly arbitrary)
it is possible to have the splits placed so that you can not see
them or even scroll around in the visible window (if .FreezePanes =
true). for example:
Application.Goto Worksheets(1).Range("A1"), True
With ActiveWindow
.SplitColumn = 100
.SplitRow = 100
.FreezePanes = True
End With
CETAB may be dealing with this in their answer.
Yes, the ActiveWindow.ScrollRow = 1 and ActivWindow.ScrollColumn = 1 is a must for FreezePanes if your visible window does not include cell A1.
If you are freezing rows 1:3 by selecting row 4 or cell A4, and cell A3 is not visible, the FreezePanes function will freeze the window in the center of the visible window.
Also if cell B4 is selected, and column A is not visible, then only the rows 1:3 will be frozen (column A will not frozen). Similarly, if rows 1:3 are not visible, only column A will be frozen. If both column A and rows 1:3 are not visible, the FreezePanes function will freeze the window in the center of the visible window.
The problem with splitting is that if a user unfreezes panes, the panes will remain split. (I couldn't find a way to turn off split afterwards while keeping the panes frozen)
This may be too obvious/simple, but what if the current selection is simply saved and then re-selected afterwards?
Sub FreezeTopRow()
'First save the current selection to go back to it later
Dim rngOriginalSelection As Range
Set rngOriginalSelection = Selection
'Change selection to A2 to make .FreezePanes work
ActiveSheet.Range("A2").Select
ActiveWindow.FreezePanes = True
'Change selection back to original
rngOriginalSelection.Select
End Sub
Here is what i use...
Public Sub FreezeTopRowPane(ByRef MyWs As Excel.Worksheet, _
Optional ByVal AfterRowNr As Integer = 1)
Dim SavedWS As Worksheet
Dim SavedUpdating As Boolean
SavedUpdating = Application.ScreenUpdating 'save current screen updating mode
Set SavedWS = ActiveSheet 'save current active sheet
Application.ScreenUpdating = False 'turn off screen updating
MyWs.Activate 'activate worksheet for panes freezing
ActiveWindow.FreezePanes = False 'turn off freeze panes in case
With ActiveWindow
.SplitColumn = 0 'set no column to split
.SplitRow = AfterRowNr 'set the row to split, default = row 1
End With
ActiveWindow.FreezePanes = True 'trigger the new pane freezing
SavedWS.Activate 'restore previous (saved) ws as active
Application.ScreenUpdating = SavedUpdating 'restore previous (saved) updating mode
End Sub
I did a timing test of Freezing using .Select vs .Activate. Here is the code
Dim numLoops As Long
Dim StartTime, LoopTime As Long
numLoops = 1000
Debug.Print ("Timing test of numloops:" & numLoops)
StartTime = Timer
For I = 0 To numLoops
targetSheet.Activate
With ActiveWindow
If .FreezePanes Then .FreezePanes = False
.SplitColumn = 2
.SplitRow = 1
.FreezePanes = True
End With
Next I
LoopTime = Timer
Debug.Print ("Total time of activate method:" & Format((LoopTime - StartTime) / 86400, "hh:mm:ss"))
StartTime = Timer
For I = 0 To numLoops
targetSheet.Select
Application.Range("C2").Select
Application.ActiveWindow.FreezePanes = True
Next I
LoopTime = Timer
Debug.Print ("Total time of select method:" & Format((LoopTime - StartTime) / 86400, "hh:mm:ss"))
And here are the results.
Timing test of numloops:1000
Total time of activate method:00:00:39
Total time of select method:00:00:01
As you can see, .Select is much faster.
I want to freeze the range S1:Y17, hide the columns A:R, and from column Z onward I only want to freeze the top 2 rows.
Is that possible?
Range("A1").Select
With ActiveWindow
.SplitColumn = 1
.SplitRow = 1
.FreezePanes = True
End With
You can play with split column and rows.
There is no way to accomplish this using any of the options under any of the ribbons.
Alternatively you can set your freeze point at Z18, especially since columns A:R are hidden or use View>New Window and then Arrange All.
sure just select a cell Z3, and on the Window menu click Freeze Panes
and in VBA, try this:
Range("Z3").select
ActiveWindow.FreezePanes = True
This was possible in older versions of excel. You could select any cell, go to the windows tab and the Freeze Panes. Everything to the left and above that cell was frozen. But Microsoft seems determined to remove more functionality with each new version of Office. Each has fewer of the old functions we knew and loved. Soon, you might as well use Works, or Open Office. I wish I could switch to Word Perfect, but too many companies are using MS Office.
I know this question is old but I visit it often enough that I thought I would add a VBA version of #daniellopez46's answer. This code will:
Create a second window of your spreadsheet
Tile the windows vertically (side by side)
Show a range starting at column S on one window
Scroll to column Z onward on the second window
Freeze the top 2 rows of the second window
Once you are finished working on the spreadsheet and close one of the windows you may not want to keep the formatting that was done, so I included a ResetWindow macro.
Sub MacroA()
Dim window1 As Window
Set window1 = ActiveWindow
ResetWindowA
Dim window2 As Window
Set window2 = window1.NewWindow
Windows.Arrange xlArrangeStyleVertical
With window2
'jumps to column S
.ScrollRow = 1
.ScrollColumn = 19
End With
With window1
'jumps to column Z
.ScrollRow = 1
.ScrollColumn = 26
'freezes the first two rows
.SplitRow = 2
.SplitColumn = 0
.FreezePanes = True
End With
End Sub
Sub ResetWindowA()
With ActiveWindow
'reset previous freeze, if any
.FreezePanes = False
.SplitRow = 0
.SplitColumn = 0
End With
End Sub
If you would like code that hides the ranges you're not using instead of simply scrolling over to where you want to work, I made the next snippet as well to hide all but the ranges you're working with.
It also has its own ResetWindow for when you're done working with both windows and want to close and save the document.
Sub MacroB()
Dim window1 As Window
Set window1 = ActiveWindow
ResetWindowB
Dim window2 As Window
Set window2 = window1.NewWindow
Windows.Arrange xlArrangeStyleVertical
With window2
.ScrollRow = 1
.ScrollColumn = 1
'Hide all but S1:Y17
Columns("A:R").EntireColumn.Hidden = True
Columns("Z:XFD").EntireColumn.Hidden = True
Rows(18 & ":" & Rows.Count).EntireRow.Hidden = True
End With
With window1
.ScrollRow = 1
.ScrollColumn = 1
'Hide all columns before Z
Columns("A:Y").EntireColumn.Hidden = True
'freezes the first two rows
.SplitRow = 2
.SplitColumn = 0
.FreezePanes = True
End With
End Sub
Sub ResetWindowB()
'unhide rows
If Columns("XFD").EntireColumn.Hidden = True Then
Columns("A:R").EntireColumn.Hidden = False
Columns("Z:XFD").EntireColumn.Hidden = False
Rows(18 & ":" & Rows.Count).EntireRow.Hidden = False
Else
Columns("A:Y").EntireColumn.Hidden = False
End If
With ActiveWindow
'reset previous freeze, if any
.FreezePanes = False
.SplitRow = 0
.SplitColumn = 0
.ScrollRow = 1
.ScrollColumn = 1
End With
End Sub