VBA Code:
Sub Test()
'
Dim ArrayRow As Long
Dim LastRow As Long, StartRowColumnB As Long
Dim StartRowColumnA As Long
Dim RowOffset As Long
Dim RangesToHide As Range
Dim RangesToIncreaseRowHeighth As Range
Dim InputArray As Variant
'
Application.ScreenUpdating = False ' Turn ScreenUpdating off
'
LastRow = 2208 ' <--- Set this to the last row to be used in column B, you may want to calculate this
StartRowColumnB = 5 ' <--- Set this to the start row of data in column B
'
InputArray = Range("B" & StartRowColumnB & ":B" & LastRow) ' Load column B range values into 2D 1 based InputArray
RowOffset = StartRowColumnB - 1 ' Calculate the RowOffset for our addresses we will be converting
'
For ArrayRow = LBound(InputArray, 1) To UBound(InputArray, 1) ' Loop through rows of InputArray
If InputArray(ArrayRow, 1) = vbNullString Then ' If cell is 'blank' then ...
If Not RangesToHide Is Nothing Then ' If RangesToHide already has entries then ...
Set RangesToHide = Union(RangesToHide, Range("B" & ArrayRow + RowOffset & "" & _
":" & "B" & ArrayRow + RowOffset & "")) ' Add the Range to hide to RangesToHide
Else ' Else ...
Set RangesToHide = Range("B" & ArrayRow + RowOffset & "" & ":" & "B" & _
ArrayRow + RowOffset & "") ' Save the Range to hide to RangesToHide
End If
End If
Next ' Loop back
'
If Not RangesToHide Is Nothing Then RangesToHide.EntireRow.Hidden = True ' Hide all the RangesToHide rows in one swoop
'
'---------------------------------------------------------------------------------------------------
'
' Column B rows are now hidden
'
' Set row heighths of remaining Column A entries to 40 if Length of column A entry is > 60 characters
'
'
LastRow = Range("A" & Rows.Count).End(xlUp).Row '
StartRowColumnA = Range("A" & 1).End(xlDown).Row '
'
InputArray = Range("A" & StartRowColumnA & ":A" & LastRow)
'
RowOffset = StartRowColumnA - 1 ' Calculate the RowOffset for our addresses we will be converting
'
For ArrayRow = LBound(InputArray, 1) To UBound(InputArray, 1) ' Loop through rows of InputArray
If Len(InputArray(ArrayRow, 1)) > 60 Then ' If length of cell is > 60 then ...
If Not RangesToIncreaseRowHeighth Is Nothing Then ' If RangesToIncreaseRowHeighth already has entries then ...
Set RangesToIncreaseRowHeighth = Union(RangesToIncreaseRowHeighth, Range("A" & _
ArrayRow + RowOffset & "" & ":" & "A" & ArrayRow + RowOffset & "")) ' Add the Range to increase row height to RangesToIncreaseRowHeighth
Else ' Else ...
Set RangesToIncreaseRowHeighth = Range("A" & ArrayRow + RowOffset & "" & ":" & "A" & _
ArrayRow + RowOffset & "") ' Save the Range to increase row height to RangesToIncreaseRowHeighth
End If
End If
Next ' Loop back
'
If Not RangesToIncreaseRowHeighth Is Nothing Then RangesToIncreaseRowHeighth.RowHeight = 40 ' Increase all the row heights in one swoop
'
'---------------------------------------------------------------------------------------------------
'
Set RangesToIncreaseRowHeighth = Nothing
'
For ArrayRow = 33 To 2208 Step 29 ' Loop through rows
If Not RangesToIncreaseRowHeighth Is Nothing Then ' If RangesToIncreaseRowHeighth already has entries then ...
Set RangesToIncreaseRowHeighth = Union(RangesToIncreaseRowHeighth, Range("A" & _
ArrayRow & "" & ":" & "A" & ArrayRow & "")) ' Add the Range to increase row height to RangesToIncreaseRowHeighth
Else ' Else ...
Set RangesToIncreaseRowHeighth = Range("A" & ArrayRow & "" & ":" & "A" & _
ArrayRow & "") ' Save the Range to increase row height to RangesToIncreaseRowHeighth
End If
Next ' Loop back
'
If Not RangesToIncreaseRowHeighth Is Nothing Then RangesToIncreaseRowHeighth.RowHeight = 40 ' Increase all the row heights in one swoop
'
'---------------------------------------------------------------------------------------------------
'
Application.ScreenUpdating = True ' Turn ScreenUpdating back on
'
MsgBox "Completed." ' Let user know that script has completed
End Sub
Thanks Johnny, this works but there is an issue with the blank sheets when all rows in the offset range are set to 40.
I forgot these rows being changed has a signature image in column B, so when the row height is set, all the signatures on every sheet show because the associated row is now 40 high.
Can this be modified so that it only performs the row height change if there is a value in the previous cell in column B?
The cell before the signature box has text determined by an IF function. The true value of the IF function means the cell is "", and the false value of the IF function means there is text in the cell.
Therefore, if the row height is only set to 40 when the previous cell has text, then this would mean all blank sheets would stay completely hidden and only sheets with data would show.
i.e.
Set Row Height for Cells B33, B62, B91, B120, B149,........B2208 = 40, If the cell before it has a value (text string) -->B32, B61, B90, B119, B148........B2207 = "Text String"
But, If the cell before it has no text string value (has formula but blank), skip the row height change.
Hope that makes sense.
I really appreciate your help with this.