CODEWITHSUNDEEP
excelvbarange
Grundy
Grundy

Reputation: 21

copy a range from one worksheet to another without blank rows

I have a range named in a worksheet that is five columns wide and approximately 220 rows long. The rows within that range are primarily formulas that pull data from other locations and concatenate or otherwise manipulate it. Some of the rows in the range are made up of cells that are entirely blank (no formula) or may contain a formula that returns no value.

A blank row would always have either a formula that resolves to no value or no formula at all in all of its cells. When a row is blank, all cells in that row meet that condition, so it could be tested on the cells in the first column, but the test would have to be after the value of the formula is calculated (otherwise the formula in the cell would be evaluated as "not blank")

I want to copy that range and paste the values that the formulas return, omitting any blank rows, starting at cell E5 of a second sheet.

The below code does what I want except that it does not omit the blank rows:

Sub RangeRefactor()

    Dim wsI As Worksheet

    Dim wsO As Worksheet

    Set wsI = ThisWorkbook.Sheets("InputSheet")

    Set wsO = ThisWorkbook.Sheets("OutputSheet")

    With Range("Refactor")

        .Copy

        wsO.Range("e5").PasteSpecial xlPasteValues

    End With

End Sub

I can't figure out how to delete the blank rows while the range is in memory and before it is pasted. Most of the solutions I have reviewed have used methods that I think would delete the rows in the InputSheet before the range is copied, which is not desired (i.e. SpecialCells(xlCellTypeBlanks).Select / Selection.EntireRow.Delete)

The answer may be that the range has to be loaded into an array for manipulation before pasting, but I am hoping that there is a simpler method because I haven't worked with arrays in a long, long time. Thanks for any help!

Upvotes: 2

Views: 138

Answers (1)

VBasic2008
VBasic2008

Reputation: 55073

Copy Values of Non-Blank Rows

  • The named range Refactor in the screenshot is range A2:D21 on the sheet InputSheet in the workbook containing this code (ThisWorkbook).
  • No column can be used to determine that a row is blank so the code loops through the columns of each row until it hits a non-blank value when it copies the entire row to the top of the array. If all values are blank, it skips that row.

enter image description here

Main

Sub CopyRefactor()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim sws As Worksheet: Set sws = wb.Sheets("InputSheet")
    Dim srg As Range: Set srg = sws.Range("Refactor")
    
    Dim dws As Worksheet: Set dws = wb.Sheets("OutputSheet")
    Dim dcell As Range: Set dcell = dws.Range("E5")
    
    CopyNonBlankRows srg, dcell

End Sub

Help

Sub CopyNonBlankRows(ByVal srg As Range, dcell As Range)

    Dim rCount As Long: rCount = srg.Rows.Count
    Dim cCount As Long: cCount = srg.Columns.Count
    
    Dim Data() As Variant
    
    If rCount + cCount = 2 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = srg.Value
    Else
        Data = srg.Value
    End If
    
    Dim sr As Long, c As Long, drCount As Long
    
    For sr = 1 To rCount
        For c = 1 To cCount
            If Len(CStr(Data(sr, c))) > 0 Then Exit For
        Next c
        If c <= cCount Then
            drCount = drCount + 1
            For c = 1 To cCount
                Data(drCount, c) = Data(sr, c)
            Next c
        End If
    Next sr

    If drCount = 0 Then Exit Sub ' no non-blank rows found
    
    dcell.Resize(drCount, cCount).Value = Data

End Sub

Upvotes: 0

Related Questions