I am currently working on a VBA project that assigns sequence numbers to a list of tasks based on their indent spacing. Currently it will work if there are 0 or 1 blank lines between steps, but if there are 2 or more blank lines between steps, it stops. I would like this to work for any number of blank lines.
In the VBA code, I currently have:
' Loop through cells with project tasks and generate WBS
Do While Not (IsEmpty(Cells(r, 2)) And IsEmpty(Cells(r + 1, 2)))
I can get it to skip more lines by adding:
And IsEmpty(Cells(r + 3, 2)) And IsEmpty(Cells(r + 4, 2)) And IsEmpty(Cells(r + 5, 2)).....
I am looking for a way for it to skip any number of blank lines 1 to 100.
Current VBA Code:
'Layout Assumptions:
'Row 1 contains column headings
'Column A contains WBS numbers
'Column B contains Task description, with appropriate indentation
'Some text (here we assume "END OF PROJECT") delimits the end of the task list
Sub WBSNumbering()
On Error Resume Next
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
'Format WBS column as text (so zeros are not truncated)
ActiveSheet.Range("A:A").NumberFormat = "@"
ActiveSheet.Range("A:A").HorizontalAlignment = xlRight
ActiveSheet.Range("2:2").HorizontalAlignment = xlLeft
Dim r As Long 'Row counter
Dim depth As Long 'How many "decimal" places for each task
Dim wbsarray() As Long 'Master array holds counters for each WBS level
Dim basenum As Long 'Whole number sequencing variable
Dim wbs As String 'The WBS string for each task
Dim aloop As Long 'General purpose For/Next loop counter
r = 3 'Starting row
basenum = 0 'Initialize whole numbers
ReDim wbsarray(0 To 0) As Long 'Initialize WBS ennumeration array
'Loop through cells with project tasks and generate WBS
Do While Not (IsEmpty(Cells(r, 2)) And IsEmpty(Cells(r + 1, 2)))
'Ignore empty tasks in column B
If Cells(r, 2) <> "" Then
'Skip hidden rows
If Rows(r).EntireRow.Hidden = False Then
'Get indentation level of task in col B
depth = Cells(r, 2).IndentLevel
'Case if no depth (whole number master task)
If depth = 0 Then
'increment WBS base number
basenum = basenum + 1
wbs = CStr(basenum)
ReDim wbsarray(0 To 0)
'Case if task has WBS depth (is a subtask, sub-subtask, etc.)
Else
'Resize the WBS array according to current depth
ReDim Preserve wbsarray(0 To depth) As Long
'Repurpose depth to refer to array size; arrays start at 0
depth = depth - 1
'Case if this is the first subtask
If wbsarray(depth) <> 0 Then
wbsarray(depth) = wbsarray(depth) + 1
'Case if we are incrementing a subtask
Else
wbsarray(depth) = 1
End If
'Only ennumerate WBS as deep as the indentation calls for;
'so we clear previous stored values for deeper levels
If wbsarray(depth + 1) <> 0 Then
For aloop = depth + 1 To UBound(wbsarray)
wbsarray(aloop) = 0
Next aloop
End If
'Assign contents of array to WBS string
wbs = CStr(basenum)
For aloop = 0 To depth
wbs = wbs & "." & CStr(wbsarray(aloop))
Next aloop
End If
'Populate target cell with WBS number
Cells(r, 1).Value = wbs
'Get rid of annoying "number stored as text" error
Cells(r, 1).Errors(xlNumberAsText).Ignore = True
'Apply text format: next row is deeper than current
If Cells(r + 1, 2).IndentLevel > Cells(r, 2).IndentLevel Then
Cells(r, 1).Font.Bold = False
Cells(r, 2).Font.Bold = False
Cells(r, 2).Font.Underline = False
'Else (next row is same/shallower than current) no format
Else
Cells(r, 1).Font.Bold = False
Cells(r, 2).Font.Bold = False
Cells(r, 2).Font.Underline = False
End If
'Special formatting for master (whole number) tasks)
If Cells(r, 2).IndentLevel = 0 Then
Cells(r, 1).Font.Bold = True
Cells(r, 2).Font.Bold = True
Cells(r, 2).Font.Underline = True
HPageBreaks.Add.Cells (r)
'Add whatever other formatting you want here
End If
End If
End If
'Go to the next row
r = r + 1
Loop
Rows.Hidden = False
End Sub
I have tried to define a variable "n" to be all values 1 to 100 so that it will essentially do r+1, r+2, r+ 3, r+4... without having to type them all out.
Do While Not (IsEmpty(Cells(r, 2)) And IsEmpty(Cells(r + n, 2)))
I have been unable to get a variable to be this range of values and work in the workbook.
I have created a range in the workbook of values 1 to 100, I have defined the variable as an array, but that still requires typing out all the numbers. Looking for a simple and clean fix to do
Do While Not (IsEmpty(Cells(r, 2)) And IsEmpty(Cells(r + n, 2)))
with n being numbers 1 to 100.
Determine the last row of your data, and then check the values to skip the blank rows.
Also: make sure to qualify ALL of your sheet references
Option Explicit
Sub Example()
Dim thisWS As Worksheet
Set thisWS = ActiveSheet
With thisWS
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Dim r As Long
For r = 3 To lastRow
'--- ignore empty tasks in column B
If .Cells(r, 2) <> "" Then
'--- skip hidden rows
If Not .Rows(r).EntireRow.Hidden Then
'--- do stuff
End If
End If
Next r
End With
End Sub