C
c1802362
Hello, everyone. Need a sanity check.
My wife uses an Excel reporting template from her work that was
provided by her corporate office. The template captures rows of data.
Where two or more rows of contiguous data are in a similar group, the
decision was made to merge cells in column E across these rows.
The creator of the spreadsheet added two buttons at the top of the
page. The desired outcome of clicking one button is that it hides any
row (or rows) where the content of the corresponding cells in column E
have an ‘O’ in them. The second button’s purpose is to restore the
spreadsheet to its original view of all rows visible (and column E
merged appropriately). The creator of the spreadsheet evidently turned
on the macro recorder and figured all was well. When I got the
template, neither button worked as advertised.
So, I’ve written the code below to manipulate the template as desired.
My code unmerges each group of cells in Column E with an ‘O’ value,
adds a sequential numerical ID, then hides the row. The code skips any
section head that has gray shading or where cells in column E are
merged, but don’t have the ‘O’ value.
When the original view needs to be restored, column E of the hidden
rows are remerged using the sequential ID, and replaced with the ‘O’.
I’m using an open cell in the template header (E4) to flag which state
the template is in (‘O’ for original, ‘X’ for unmerged)
My problem: running this on my wife’s company network, it’ll either
run instantaneously, with barely a perceptible delay in execution, or
it takes 28 seconds to execute the hiding routine (HideCells) and 1-2
seconds to restore the template to its original form (ViewCells).
There’s no rhyme or reason as to how fast it decides to run.
Is there something in my code that causes the code to arbitrarily run
slow or fast? Or is there something in my wife’s corporate network
that is the problem?
Her network is running Windows 2003, 2007, and 2010 (large corporation
with staggered software upgrades). I haven’t seen a difference between
the software versions when she’s had others in her office use the
template.
Art
Here’s the code:
Option Explicit
Dim i As Integer, intRowCount As Integer
Const TargetRow = 7 ' starting row of data
Const TargetCol = 5 ' column of interest
Const LetterO = "O"
Const LetterX = "X"
Private Sub HideCells()
'***********************************************************************
' This routine hides all rows of data that have an 'O' in column E
' including those cells in column E merged together. Algorithm skips
' over any rows with gray shading or those where column E is empty.
' Algorithm then unmerges cells in column E and assigns a sequential
' integer ID to those cells previously merged
'***********************************************************************
Dim rngActive As Range, intMergeCounter As Integer
If Cells(4, TargetCol) = LetterX Then Exit Sub 'checks flag
Application.ScreenUpdating = False
' index to identify which rows stay together
' replaces 'O' in column E while hidden
intMergeCounter = 1
intRowCount = Range("C65000").End(xlUp).Row
For i = intRowCount To TargetRow Step -1
' skip any row with gray shaded headings
If Cells(i, TargetCol).Interior.ColorIndex <> 15 Then
' skip any rows where column E is empty
If Cells(i, TargetCol) = LetterO Then
Cells(i, TargetCol).Activate
' capture merged areas in column E and add unique
' integer to all cells in captured range
Set rngActive = ActiveCell.MergeArea
With rngActive
.UnMerge
.Value = intMergeCounter
End With
' once unique integer is added, hide rows
rngActive.EntireRow.Hidden = True
intMergeCounter = intMergeCounter + 1
End If
End If
Next i
Cells(4, TargetCol) = LetterX ' sets flag
Application.ScreenUpdating = True
End Sub
Private Sub ViewCells()
'***********************************************************************
' This routine unhides all rows of data, merges the cells in column E
' by integer ID, then replaces the ID in each merged cell with an 'O'
'***********************************************************************
Dim intMaxCount As Integer, x As Integer, intAdder As Integer
If Cells(4, TargetCol) = LetterO Then Exit Sub ' checks flag
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
intRowCount = Range("C65000").End(xlUp).Row
' unhide all rows of data
Rows(TargetRow & ":" & intRowCount).EntireRow.Hidden = False
' count the number of sequential integer IDs generated
intMaxCount =
Application.WorksheetFunction.Max(Columns(TargetCol))
x = 1 ' sequential integer ID counter
Do Until x > intMaxCount
intAdder = 1 ' merged cell counter
With Columns(TargetCol)
.Find(What:=x, After:=Cells(1, TargetCol), LookIn:=xlFormulas,
lookat:=xlWhole).Activate
Do Until ActiveCell.Offset(intAdder, 0) <> ActiveCell
intAdder = intAdder + 1 ' counts the number of rows that
need to be merged together
Loop
intAdder = intAdder - 1 'corrects count
End With
With Range(ActiveCell, ActiveCell.Offset(intAdder, 0))
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.MergeCells = True
.FormulaR1C1 = LetterO
End With
x = x + 1
Loop
Cells(4, TargetCol) = LetterO ' sets flag
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
My wife uses an Excel reporting template from her work that was
provided by her corporate office. The template captures rows of data.
Where two or more rows of contiguous data are in a similar group, the
decision was made to merge cells in column E across these rows.
The creator of the spreadsheet added two buttons at the top of the
page. The desired outcome of clicking one button is that it hides any
row (or rows) where the content of the corresponding cells in column E
have an ‘O’ in them. The second button’s purpose is to restore the
spreadsheet to its original view of all rows visible (and column E
merged appropriately). The creator of the spreadsheet evidently turned
on the macro recorder and figured all was well. When I got the
template, neither button worked as advertised.
So, I’ve written the code below to manipulate the template as desired.
My code unmerges each group of cells in Column E with an ‘O’ value,
adds a sequential numerical ID, then hides the row. The code skips any
section head that has gray shading or where cells in column E are
merged, but don’t have the ‘O’ value.
When the original view needs to be restored, column E of the hidden
rows are remerged using the sequential ID, and replaced with the ‘O’.
I’m using an open cell in the template header (E4) to flag which state
the template is in (‘O’ for original, ‘X’ for unmerged)
My problem: running this on my wife’s company network, it’ll either
run instantaneously, with barely a perceptible delay in execution, or
it takes 28 seconds to execute the hiding routine (HideCells) and 1-2
seconds to restore the template to its original form (ViewCells).
There’s no rhyme or reason as to how fast it decides to run.
Is there something in my code that causes the code to arbitrarily run
slow or fast? Or is there something in my wife’s corporate network
that is the problem?
Her network is running Windows 2003, 2007, and 2010 (large corporation
with staggered software upgrades). I haven’t seen a difference between
the software versions when she’s had others in her office use the
template.
Art
Here’s the code:
Option Explicit
Dim i As Integer, intRowCount As Integer
Const TargetRow = 7 ' starting row of data
Const TargetCol = 5 ' column of interest
Const LetterO = "O"
Const LetterX = "X"
Private Sub HideCells()
'***********************************************************************
' This routine hides all rows of data that have an 'O' in column E
' including those cells in column E merged together. Algorithm skips
' over any rows with gray shading or those where column E is empty.
' Algorithm then unmerges cells in column E and assigns a sequential
' integer ID to those cells previously merged
'***********************************************************************
Dim rngActive As Range, intMergeCounter As Integer
If Cells(4, TargetCol) = LetterX Then Exit Sub 'checks flag
Application.ScreenUpdating = False
' index to identify which rows stay together
' replaces 'O' in column E while hidden
intMergeCounter = 1
intRowCount = Range("C65000").End(xlUp).Row
For i = intRowCount To TargetRow Step -1
' skip any row with gray shaded headings
If Cells(i, TargetCol).Interior.ColorIndex <> 15 Then
' skip any rows where column E is empty
If Cells(i, TargetCol) = LetterO Then
Cells(i, TargetCol).Activate
' capture merged areas in column E and add unique
' integer to all cells in captured range
Set rngActive = ActiveCell.MergeArea
With rngActive
.UnMerge
.Value = intMergeCounter
End With
' once unique integer is added, hide rows
rngActive.EntireRow.Hidden = True
intMergeCounter = intMergeCounter + 1
End If
End If
Next i
Cells(4, TargetCol) = LetterX ' sets flag
Application.ScreenUpdating = True
End Sub
Private Sub ViewCells()
'***********************************************************************
' This routine unhides all rows of data, merges the cells in column E
' by integer ID, then replaces the ID in each merged cell with an 'O'
'***********************************************************************
Dim intMaxCount As Integer, x As Integer, intAdder As Integer
If Cells(4, TargetCol) = LetterO Then Exit Sub ' checks flag
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
intRowCount = Range("C65000").End(xlUp).Row
' unhide all rows of data
Rows(TargetRow & ":" & intRowCount).EntireRow.Hidden = False
' count the number of sequential integer IDs generated
intMaxCount =
Application.WorksheetFunction.Max(Columns(TargetCol))
x = 1 ' sequential integer ID counter
Do Until x > intMaxCount
intAdder = 1 ' merged cell counter
With Columns(TargetCol)
.Find(What:=x, After:=Cells(1, TargetCol), LookIn:=xlFormulas,
lookat:=xlWhole).Activate
Do Until ActiveCell.Offset(intAdder, 0) <> ActiveCell
intAdder = intAdder + 1 ' counts the number of rows that
need to be merged together
Loop
intAdder = intAdder - 1 'corrects count
End With
With Range(ActiveCell, ActiveCell.Offset(intAdder, 0))
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.MergeCells = True
.FormulaR1C1 = LetterO
End With
x = x + 1
Loop
Cells(4, TargetCol) = LetterO ' sets flag
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub