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.
Related
I export two strings of text from an Excel spreadsheet to Word, use the Word Compare function to highlight and underline the differences between the two, and then export that final string with the formatting back to the Excel spreadsheet.
When this code runs down the column, sometimes the ActiveSheet.Paste line, gives me
Run-time error '1004':
Microsoft Excel cannot paste the data.
Dim previous As String: previous = Cells(i, 19).Value
Dim current As String: current = Cells(i, 20).Value
Dim wordApp As Word.Application: Set wordApp = New Word.Application
wordApp.Visible = True
Dim firstdoc As Word.Document: Set firstdoc = wordApp.Documents.Add
firstdoc.Paragraphs(1).Range.Text = previous
Dim seconddoc As Word.Document: Set seconddoc = wordApp.Documents.Add
seconddoc.Paragraphs(1).Range.Text = current
Dim lastdoc As Word.Document
Set lastdoc = wordApp.CompareDocuments(firstdoc, seconddoc, wdCompareDestinationNew)
With lastdoc.ActiveWindow.View.RevisionsFilter
.Markup = wdRevisionsMarkupAll
.View = wdRevisionsViewFinal
End With
lastdoc.Content.FormattedText.Copy
Cells(i, 20).Activate
Cells(i, 20).Select
PAUSE 3
ActiveSheet.Paste 'Where the program always stops for some reason.
firstdoc.Close SaveChanges:=wdDoNotSaveChanges
seconddoc.Close SaveChanges:=wdDoNotSaveChanges
lastdoc.Close SaveChanges:=wdDoNotSaveChanges
wordApp.Visible = False
When I hit debug and F5 (Continue), it begins to work again like normal. If I have 30 rows of text, this might occur 5-6 times throughout the program execution. I know it has nothing to do with the extent of text it's handling because this error occurs randomly down the row, sometimes when pasting a large block of text or sometimes pasting a small block of text.
Someone suggested that I use the PAUSE 3 Subroutine to slow down the program for Excel to catch up. It did decrease the frequency of the error message.
What could be going on and how do I fix it?
Sub PAUSE(Period As Single)
Dim t As Single
Period = 0.5
t = Timer + Period
Do
DoEvents
Loop Until t < Timer
End Sub
You can retry the paste if it fails - this has always worked for me when a single attempt to paste was failing sometimes.
Replace this:
lastdoc.Content.FormattedText.Copy
Cells(i, 20).Activate
Cells(i, 20).Select
PAUSE 3
ActiveSheet.Paste 'Where the program always stops for some reason
with:
Dim n As Long, pasted As Boolean
'...
'...
lastdoc.Content.FormattedText.Copy
pasted = False 'reset paste status flag
For n = 1 To 10 'try 10 times to paste
On Error Resume Next 'ignore any paste error
ActiveSheet.Paste Destination:=ActiveSheet.Cells(i, 20)
pasted = (Err.Number = 0) 'no error = pasted OK
On Error GoTo 0 'stop ignoring errors
If pasted Then Exit For 'exit if pasted OK
DoEvents
Next n
If Not pasted Then 'was there a problem pasting?
MsgBox "Problem pasting!"
End If
'...
'...
I have this code but it only work for my first row.
It is suppose to look if the checkbox on B, C or D is checked, and if so, a date + username will automaticaly fill in F and G.
here is a picture of my table:
This is what my code looks like:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("B2") Or Range("C2") Or Range("D2") = True Then
Range("G2").Value = Environ("Username")
Range("F2").Value = Date
Else
Range("F2:G2").ClearContents
End If
End Sub
Enter this code in a regular module, select all your checkboxes and right-click >> assign macro then choose ReviewRows.
This will run the check whenever a checkbox is clicked - a bit of overhead since all rows will be checked, but should not be a big deal.
Sub ReviewRows()
Dim n As Long
For n = 1 To 100 'for example
With Sheet1.Rows(n)
If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
.Cells(6) = Date
.Cells(7) = Environ("Username")
End If
Else
.Cells(6).Resize(1, 2).ClearContents
End If
End With
Next n
End Sub
If you want to be more precise then Application.Caller will give you the name of the checkbox which was clicked, and you can use that to find the appropriate row to check via the linkedCell.
Sub ReviewRows()
Dim n As Long, shp As CheckBox, c As Range, ws As Worksheet
Set ws = ActiveSheet
On Error Resume Next 'ignore error in case calling object is not a checkbox
Set shp = ActiveSheet.CheckBoxes(Application.Caller) 'get the clicked checkbox
On Error GoTo 0 'stop ignoring errors
If Not shp Is Nothing Then 'got a checkbox ?
If shp.LinkedCell <> "" Then 'does it have a linked cell ?
With ws.Range(shp.LinkedCell).EntireRow
If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
.Cells(6) = Date
.Cells(7) = Environ("Username")
End If
Else
.Cells(6).Resize(1, 2).ClearContents
End If
End With
End If 'has linked cell
End If 'was a checkbox
End Sub
However this appraoch is sensitive to the exact positioning of your checkbox
You have a long way to go!
Unfortunately, If Range("B2") Or Range("C2") Or Range("D2") = True Then is beyond repair. In fact, your entire concept is.
Start with the concept: Technically speaking, checkboxes aren't on the worksheet. They are on a layer that is superimposed over the worksheet. They don't cause a worksheet event, nor are they responding to worksheet events. The good thing is that they have their own.
If Range("B2") Or Range("C2") Or Range("D2") = True Then conflates Range with Range.Value. One is an object (the cell), the other one of the object's properties. So, to insert sense into your syntax it would have to read, like, If Range("B2").Value = True Or Range("C2").Value = True Or Range("D2").Value = True Then. However this won't work because the trigger is wrong. The Worksheet_Change event won't fire when when a checkbox changes a cell's value, and the SelectionChange event is far too common to let it run indiscriminately in the hope of sometimes being right (like the broken clock that shows the correct time twice a day).
The answer, therefore is to capture the checkbox's click event.
Private Sub CheckBox1_Click()
If CheckBox1.Value = vbTrue Then
MsgBox "Clicked"
End If
End Sub
Whatever you want to do when the checkbox is checked must be done where it now shows a MsgBox. You can also take action when it is being unchecked.
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 recorded a macro to freeze panes, but it is not working as intended. It freezes at the 2nd row and makes the top row hidden. Help. I am using Excel 2007. The code is below:
' Freeze Pains - Top Row
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
I found this code works perfectly:
Sub Freeze_Top_Panes()
Application.ScreenUpdating = False
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Application.ScreenUpdating = True
End Sub
To achieve this for all sheets in your workbook, try this:
Sub Freeze_All()
Dim Ws As Worksheet
Application.ScreenUpdating = False
For Each Ws In Application.ActiveWorkbook.Worksheets
Ws.Activate
With Application.ActiveWindow
.FreezePanes = True
End With
Next
Application.ScreenUpdating = True
End Sub
Ii am not sure if this only affects Excel 2007 (as I have not tested it on other versions yet), but it appears that you must turn off screen updating for the freeze panes function to work with VBA. Not sure as to why that is.
If you want to freeze the first row/column, but the first row/column is not displayed on the screen, the macro will not freeze the first row/column as expected.
To solve this issue you have to use the ScrollRow (or Scrollcolumn) property.
Worksheets(1).Cells(1, 1).Select
With ActiveWindow
If .FreezePanes Then .FreezePanes = False
.ScrollRow = 1
.ScrollColumn = 1
.SplitColumn = 5
.SplitRow = 5
.FreezePanes = True
End With
I propose you the snippet enclosed (to freeze after row 5 and column 5)
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