excelvbarange

Assigning Multiple Values to Single Variable in VBA


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.

Screenshot of Excel File and how numbering works

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.


Solution

  • 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