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