Can I form arrays for only cells with calculated data, and disregard cells with no data and just underlying formulas?

Viewed 60

Is it possible to only form arrays with text inside cells instead of looping through empty cells with formulas embedded?

For example I have a script that gathers the UBound's of both dimensions, but it also loops through the cells with no calculated data (appearing empty). This causes the run-time to increase a lot as I have formulas embedded to span 1000 columns and 62 rows.

How could I tell this script to only form an array with cells that have calculated text and to ignore any visibly empty cells with formulas embedded?

Option Explicit

Sub Main()
  Dim wb As Workbook
  Dim Data, Last, JobFamily
  Dim sourcerow As Long, destcol As Long, sourcecol As Long, destrow As Long
  Dim Dest As Range
  Dim BASEPATH As String

  Dim sPath, sFile As String

  BASEPATH = "M:\Combine\"

  sPath = "M:\VBA\"
  sFile = sPath & "Book2.xlsx"

  Set wb = Workbooks.Open(sFile)
  Set Dest = wb.Sheets("Sheet1").Range("B1")
  With ThisWorkbook.Sheets("Profiles")
    Data = .Range("B1", .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, .Columns.Count).End(xlToLeft))
  End With
  wb.Activate
  Application.ScreenUpdating = False

  For sourcecol = 1 To UBound(Data, 2)
    If Data(1, sourcecol) <> Last Then
      If sourcecol > 1 Then
        Dest.Select
          wb.SaveCopyAs BASEPATH & _
          ValidFileName(Last & ".xlsx")
      End If

      Dest.Resize(, Columns.Count - Dest.Column).EntireColumn.ClearContents
      Last = Data(1, sourcecol)
      destcol = 0
    End If

    destrow = 0
    For sourcerow = 1 To UBound(Data)
      Dest.Offset(destrow, destcol) = Data(sourcerow, sourcecol)
      destrow = destrow + 1
    Next

    destcol = destcol + 1
  Next
End Sub
1 Answers

Yes, you can use the SpecialCells method of the Range object. Here's a small self contained demo. More info here SpecialCells

Private Sub BuildConstantRange()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        .Cells(1, 1).Value = "1"
        .Cells(2, 1).Value = "2"
        .Cells(3, 1).Value = "=if(1=1,1,0)"
        .Cells(4, 1).Value = "=if(1=1,1,0)"
        .Cells(5, 1).Value = "3"

        Dim rng As Range: Set rng = .Range("A1:A5").SpecialCells(xlCellTypeConstants)
        Dim cell As Range

        For Each cell In rng
            Debug.Print cell.Address
        Next
    End With

End Sub

Output is:

$A$1
$A$2
$A$5

Which are the cells that do not have a formula.

Related