VBA on arrays runs too slow - excel

Question

The file I work on contains about 80,000 rows
I need to perform some basic checks and copy the results to the new sheet.
The whole thing takes about 8 minutes and I think its too long, is there any faster way?
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
lastCell = checkbook.UsedRange.Rows.Count
ReDim dataArray(2 To lastCell, 1 To 4)
For i = 2 To lastCell
dataArray(i, 1) = checkbook.Range(streetAddress & i).Value
dataArray(i, 2) = checkbook.Range(cityAddress & i).Value
dataArray(i, 3) = checkbook.Range(stateAddress & i).Value
dataArray(i, 4) = checkbook.Range(postCodeAddress & i).Value
Next I
For i = 2 To lastCell
If dataArray(i, 1) = "" Then
results.Range("A" & results.UsedRange.Rows.Count + 1 & ":" & lastCol & results.UsedRange.Rows.Count + 1).Value = checkbook.Range("A" & i & ":" & lastCol & i).Value
results.Range(commentAddress & results.UsedRange.Rows.Count).Value = "BLANK Street"
End If
If dataArray(i, 2) = "" Then
results.Range("A" & results.UsedRange.Rows.Count + 1 & ":" & lastCol & results.UsedRange.Rows.Count + 1).Value = checkbook.Range("A" & i & ":" & lastCol & i).Value
results.Range(commentAddress & results.UsedRange.Rows.Count).Value = "BLANK City"
End If
If dataArray(i, 3) = "" Then
results.Range("A" & results.UsedRange.Rows.Count + 1 & ":" & lastCol & results.UsedRange.Rows.Count + 1).Value = checkbook.Range("A" & i & ":" & lastCol & i).Value
results.Range(commentAddress & results.UsedRange.Rows.Count).Value = "BLANK State"
End If
If dataArray(i, 4) = "" Then
results.Range("A" & results.UsedRange.Rows.Count + 1 & ":" & lastCol & results.UsedRange.Rows.Count + 1).Value = checkbook.Range("A" & i & ":" & lastCol & i).Value
results.Range(commentAddress & results.UsedRange.Rows.Count).Value = "BLANK PostCode"
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Answer 1

I feel your pain, I had a sheet like that as well. Working cell by cell will be slow.
Try:
1) Can you try copy the whole Sheet not cell by cell so you have a backup before processing your blanks.
Some of my old code that you can use to modify, copy whole range in one go and put values in a brand new sheet:
Dim s1 As Worksheet
Dim s2 As Worksheet
Set s1 = ThisWorkbook.Sheets(strSourceSheet)
' What is range of source data
lastrow = s1.UsedRange.Rows.Count
lastcol = s1.UsedRange.Columns.Count
' copy across
s1.Range(s1.Cells(1, 1), s1.Cells(lastrow, lastcol)).Copy
' Create new empty worksheet for holding values
Set s2 = Worksheets.Add
s2.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, SkipBlanks:=True
Application.CutCopyMode = False
' You can rename this s2 sheet
2) Then try SEARCH for your blank cells in each column and do a REPLACE. (Use Macro recorder to help get the syntax).
Some sample code below, you will need to clean this up by setting the range instead of using a select on whole column (which will add to blanks below your last row).
' go through each of your columns. Did street example here
Columns("A:A").Select
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Replace What:="", Replacement:="BLANK street", LookAt:=xlWhole _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Hope this helps. You seem to know how to code, but if you are stuck then let me know.

Answer 2

I found an answer to the problem
instead of
results.Range(commentAddress & results.UsedRange.Rows.Count)
define for e.g. j and iterate it everytime you add new value to the sheet so
results.Range("A" & k & ":" & lastCol & k ).Value = checkbook.Range("A" & i & ":" & lastCol & i).Value
results.Range(commentAddress & k).Value = "BLANK Street"
k = k + 1
from 8 mins to 5 seconds :)

Answer 3

As per my Knowledge, a Sheet to sheet Traverse is always a time taking process.
i would suggest to use an array to save the details of check and then use them while assigning the values.
results.Range("A" & results.UsedRange.Rows.Count + 1 & ":" & lastCol & results.UsedRange.Rows.Count + 1).Value = array(Value)
The other recommendation is to identify the blank cells during the array assignment only and store the locations in the separate array. so directly you can iterate through only blank values instead of going through all you 80,000