Insert empty rows inside 2d array

[YasserKhalil]

Hello everyone
I have the following code that should insert 2 rows in between each group based on the third column in 2d array. The code is working but I need some adjustments

Code: Select all

Sub MyTest()
    Dim a
    a = InsertEmptyRows(Range("A2").CurrentRegion)
    Range("A18").Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub

Function InsertEmptyRows(inputRange As Range)
    Dim inputArray(), outputArray()
    Dim numRows As Long, numCols As Long
    Dim i As Long, j As Long, lastGroupEnd As Long, outputIndex As Long
    Dim emptyRowCount As Long, k As Long
    
    inputArray = inputRange.Value
    numRows = UBound(inputArray, 1)
    numCols = UBound(inputArray, 2)
    
    emptyRowCount = 2
    ReDim outputArray(1 To numRows + (numRows - 2) * emptyRowCount + 1, 1 To numCols)
    For j = 1 To numCols
        outputArray(1, j) = inputArray(1, j)
    Next j
    
    outputIndex = 1
    For i = 2 To numRows
        If i > 2 And i <= numRows And inputArray(i, 3) <> inputArray(i - 1, 3) Then
            For k = 1 To emptyRowCount
                outputIndex = outputIndex + 1
                For j = 1 To numCols
                    outputArray(outputIndex, j) = ""
                Next j
            Next k
        End If
        outputIndex = outputIndex + 1
        For j = 1 To numCols
            outputArray(outputIndex, j) = inputArray(i, j)
        Next j
    Next i
    
    InsertEmptyRows = outputArray
End Function

I need to add an optional parameter that allows me to add headers before each group. say the headers are `headers = Array("aa", "bb", "cc", "dd", "ee")`

[HansV]

Do you need to insert them before the first group too?

[YasserKhalil]

Yes, the headers if selected True, then to insert before the first group too.

[HansV]

Can we copy the headers from an existing range, or should they be hard-coded into the function, or should they be passed as a parameter?

[YasserKhalil]

The headers should be passed as a parameter (optional) and the headers will be 1d array.

[HansV]

I added 3 parameters, the last of which is optional:

emptyRowCount is the number of empty rows to insert.
groupCol is the index number of the column on which to group.
headerRow is the optional one-dimensional array with headers.

Code: Select all

Sub MyTest()
    Dim a
    a = InsertEmptyRows(Range("A2").CurrentRegion, 2, 3, Array("aa", "bb", "cc", "dd"))
    Range("A18").Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub

Function InsertEmptyRows(inputRange As Range, emptyRowCount As Long, groupCol As Long, Optional headerRow)
    Dim inputArray(), outputArray()
    Dim numRows As Long, numCols As Long
    Dim i As Long, j As Long, lastGroupEnd As Long, outputIndex As Long
    Dim k As Long
    Dim f As Boolean
    Dim numNewRows As Long
    Dim headerCols As Long

    inputArray = inputRange.Value
    numRows = UBound(inputArray, 1)
    numCols = UBound(inputArray, 2)
    
    f = Not IsMissing(headerRow)

    numNewRows = numRows + (numRows - 2) * emptyRowCount + 1
    If f Then
        numNewRows = numNewRows + numRows - 2
        headerCols = Application.Min(numCols, UBound(headerRow) + 1)
    End If
    ReDim outputArray(1 To numNewRows, 1 To numCols)
    For j = 1 To numCols
        outputArray(1, j) = inputArray(1, j)
    Next j

    outputIndex = 1
    For i = 2 To numRows
        If i > 2 And i <= numRows And inputArray(i, groupCol) <> inputArray(i - 1, groupCol) Then
            For k = 1 To emptyRowCount
                outputIndex = outputIndex + 1
                For j = 1 To numCols
                    outputArray(outputIndex, j) = ""
                Next j
            Next k
        End If

        If f And inputArray(i, groupCol) <> inputArray(i - 1, groupCol) Then
            outputIndex = outputIndex + 1
            For j = 1 To headerCols
                outputArray(outputIndex, j) = headerRow(j - 1)
            Next j
        End If

        outputIndex = outputIndex + 1
        For j = 1 To numCols
            outputArray(outputIndex, j) = inputArray(i, j)
        Next j
    Next i

    InsertEmptyRows = outputArray
End Function

[YasserKhalil]

Amazing. The only note is that the first group has no headers and I need to include the header to the first group too.

[HansV]

The code created headers for the first group when I tested it. Could you attach a small sample workbook in which it fails?

[YasserKhalil]

Here's sample of the file

[HansV]

OK, I see now. I had some content in row 1, that's what caused the difference.
Change the function as follows. The macro remains the same.

Code: Select all

Function InsertEmptyRows(inputRange As Range, emptyRowCount As Long, groupCol As Long, Optional headerRow)
    Dim inputArray(), outputArray()
    Dim numRows As Long, numCols As Long
    Dim i As Long, j As Long, lastGroupEnd As Long, outputIndex As Long
    Dim k As Long
    Dim f As Boolean
    Dim numNewRows As Long
    Dim headerCols As Long

    inputArray = inputRange.Value
    numRows = UBound(inputArray, 1)
    numCols = UBound(inputArray, 2)
    
    f = Not IsMissing(headerRow)

    numNewRows = numRows + (numRows - 2) * emptyRowCount + 1
    If f Then
        numNewRows = numNewRows + numRows - 2
        headerCols = Application.Min(numCols, UBound(headerRow) + 1)
    End If

    ReDim outputArray(1 To numNewRows, 1 To numCols)
    If f Then
        For j = 1 To headerCols
            outputArray(1, j) = headerRow(j - 1)
        Next j
    End If

    outputIndex = 1
    For i = 2 To numRows
        If i > 2 And i <= numRows And inputArray(i, groupCol) <> inputArray(i - 1, groupCol) Then
            For k = 1 To emptyRowCount
                outputIndex = outputIndex + 1
            Next k
        End If

        If f And inputArray(i, groupCol) <> inputArray(i - 1, groupCol) Then
            outputIndex = outputIndex + 1
            For j = 1 To headerCols
                outputArray(outputIndex, j) = headerRow(j - 1)
            Next j
        End If

        outputIndex = outputIndex + 1
        For j = 1 To numCols
            outputArray(outputIndex, j) = inputArray(i, j)
        Next j
    Next i

    InsertEmptyRows = outputArray
End Function

[YasserKhalil]

Thanks a lot. Now the headers are ok for each block (each group) but I lost data for the first group.

[HansV]

Here you go

Code: Select all

Function InsertEmptyRows(inputRange As Range, emptyRowCount As Long, groupCol As Long, Optional headerRow)
    Dim inputArray(), outputArray()
    Dim numRows As Long, numCols As Long
    Dim i As Long, j As Long, lastGroupEnd As Long, outputIndex As Long
    Dim k As Long
    Dim f As Boolean
    Dim numNewRows As Long
    Dim headerCols As Long

    inputArray = inputRange.Value
    numRows = UBound(inputArray, 1)
    numCols = UBound(inputArray, 2)
    
    f = Not IsMissing(headerRow)

    numNewRows = numRows + (numRows - 2) * emptyRowCount + 1
    If f Then
        numNewRows = numNewRows + numRows - 2
        headerCols = Application.Min(numCols, UBound(headerRow) + 1)
    End If

    ReDim outputArray(1 To numNewRows, 1 To numCols)

    If f Then
        outputIndex = outputIndex + 1
        For j = 1 To headerCols
            outputArray(outputIndex, j) = headerRow(j - 1)
        Next j
    End If

    outputIndex = outputIndex + 1
    For j = 1 To numCols
        outputArray(outputIndex, j) = inputArray(1, j)
    Next j

    For i = 2 To numRows
        If i > 2 And i <= numRows And inputArray(i, groupCol) <> inputArray(i - 1, groupCol) Then
            For k = 1 To emptyRowCount
                outputIndex = outputIndex + 1
            Next k
        End If

        If f And inputArray(i, groupCol) <> inputArray(i - 1, groupCol) Then
            outputIndex = outputIndex + 1
            For j = 1 To headerCols
                outputArray(outputIndex, j) = headerRow(j - 1)
            Next j
        End If

        outputIndex = outputIndex + 1
        For j = 1 To numCols
            outputArray(outputIndex, j) = inputArray(i, j)
        Next j
    Next i

    InsertEmptyRows = outputArray
End Function

[YasserKhalil]

Amazing. That's it
Thank you very much for the great support, my tutor.