Excel & VBA

Using Group/Ungroup in protected worksheets

admin — Mon, 26 Jul 2010 14:23:35 +0000

You would have to use a Workbook_Open macro to set the protection a special way when you open the workbook.

The following needs to go in the ThisWorkbook module. The password is password - you can change the text between the quotation marks to what you need it to be. The sheet with the subtotaling is called sales - you can change that below.

Private Sub Workbook_Open()
With Worksheets("sales")
.Protect Password:="password", Userinterfaceonly:=True
.EnableOutlining = True
End With
End Sub

Crack Sheet Protection Password

admin — Thu, 20 May 2010 09:26:04 +0000

This routine provides a password to unprotect your worksheet. However, it may not give you the original password that was used.

Open the workbook that has the protected sheet in it. Hit Alt+F11 to view the Visual Basic Editor. Hit Insert-Module and paste this code into the right-hand code window:

Sub PasswordBreaker()
'Author unknown but submitted by brettdj of www.experts-exchange.com

Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126

ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If ActiveSheet.ProtectContents = False Then
MsgBox "One usable password is " & Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
ActiveWorkbook.Sheets(1).Select
Range("a1").FormulaR1C1 = Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Exit Sub
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next

End Sub

Close the VB Editor window. Navigate to the worksheet you want to unprotect. Hit Tools-Macro-Macros and double-click PasswordBreaker in the list.

Source: http://www.theofficeexperts.com/VBASamples/Excel02.htm

Display sheetname in cell formula

admin — Thu, 18 Feb 2010 10:23:26 +0000

=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,256)

Excel Diet: Reduce file size of excel workbook

admin — Thu, 22 Oct 2009 14:23:21 +0000

Option Explicit

Sub ExcelDiet()

Dim j As Long
Dim k As Long
Dim LastRow As Long
Dim LastCol As Long
Dim ColFormula As Range
Dim RowFormula As Range
Dim ColValue As Range
Dim RowValue As Range
Dim Shp As Shape
Dim ws As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

On Error Resume Next

For Each ws In Worksheets
With ws
'Find the last used cell with a formula and value
'Search by Columns and Rows
On Error Resume Next
Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
On Error Goto 0

'Determine the last column
If ColFormula Is Nothing Then
LastCol = 0
Else
LastCol = ColFormula.Column
End If
If Not ColValue Is Nothing Then
LastCol = Application.WorksheetFunction.Max(LastCol, ColValue.Column)
End If

'Determine the last row
If RowFormula Is Nothing Then
LastRow = 0
Else
LastRow = RowFormula.Row
End If
If Not RowValue Is Nothing Then
LastRow = Application.WorksheetFunction.Max(LastRow, RowValue.Row)
End If

'Determine if any shapes are beyond the last row and last column
For Each Shp In .Shapes
j = 0
k = 0
On Error Resume Next
j = Shp.TopLeftCell.Row
k = Shp.TopLeftCell.Column
On Error Goto 0
If j> 0 And k> 0 Then
Do Until .Cells(j, k).Top> Shp.Top + Shp.Height
j = j + 1
Loop
If j> LastRow Then
LastRow = j
End If
Do Until .Cells(j, k).Left> Shp.Left + Shp.Width
k = k + 1
Loop
If k> LastCol Then
LastCol = k
End If
End If
Next

.Range(Cells(1, LastCol + 1).Address & ":IV65536").Delete
.Range(Cells(LastRow + 1, 1).Address & ":IV65536").Delete
End With
Next

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Select all visible sheets in a workbook

admin — Mon, 13 Jul 2009 08:00:55 +0000

sub select_visible_sheets ()
Dim ws As Worksheet

For Each ws In Sheets
If ws.Name <> "SOURCE DATA" And ws.Visible Then ws.Select (False)
Next
End Sub

Hide zero value lines within a pivot table in Excel 2003/XP/2000/97

admin — Thu, 09 Jul 2009 12:46:19 +0000

Great article with screenshots.. Doesnt get any clearer than this:

Spreadsheet123.com

Too bad it doesnt work for rows adding up to 0 in the pivot (say source has a -10 and 10, so the pivot shows 0, the trick above doesn't work for that)..

Use a ‘check’ symbol in Excel

admin — Tue, 30 Jun 2009 08:48:52 +0000

Set font to Wingdings, and use ALT+0252..

So simple, but took me a while to get it

Macro to sort sheets in a workbook

admin — Sun, 07 Jun 2009 13:49:11 +0000

Sub Sort_Active_Book()
Dim i As Integer
Dim j As Integer
Dim iAnswer As VbMsgBoxResult
'
' Prompt the user as which direction they wish to
' sort the worksheets.
'
iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
& "Clicking No will sort in Descending Order", _
vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
For i = 1 To Sheets.Count
For j = 1 To Sheets.Count - 1
'
' If the answer is Yes, then sort in ascending order.
'
If iAnswer = vbYes Then
If UCase$(Sheets(j).Name)> UCase$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
'
' If the answer is No, then sort in descending order.
'
ElseIf iAnswer = vbNo Then
If UCase$(Sheets(j).Name) (Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
End If
Next j
Next i
End Sub

Round a figure to the nearest / highest 10,100,500 etc.

admin — Sun, 07 Jun 2009 09:54:44 +0000

If the number is in A2 just use this formula

To round to the NEAREST 500: (eg. 524 rounds to 500)
=ROUND(A2/500,0)*500

To round to the NEXT HIGHEST 500: (eg. 524 rounds to 1000)
=CEILING(A2,500)

Update all pivot tables in a workbook

admin — Thu, 28 May 2009 09:53:32 +0000

Option Explicit

Sub RefreshAllPivots()
Dim ws As Worksheet
Dim pt As PivotTable

On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
For Each pt In ws.PivotTables
pt.RefreshTable
Next
Next
End Sub