Need more efficiency than For Each Loop vba - vba

Question

I am a newcomer to vba/excel macros and need a more efficient way to run the below code. I am using a for each loop to return a value from a row based on a column's value (same row). The code works, but takes far too much processing power and time to get through the loops (often freezing the computer or program). I would appreciate any suggestions...
'The following is searching each cell in a range to determine if a cell is not empty. If the cell is not empty, the macro will copy the value of the cell and paste it in to another worksheet (same row)
Set rng = Worksheets("Demographic").Range("AU2:AU" & lastRow)
i = "2"
For Each cell In rng
If Not IsEmpty(cell.Value) Then
Sheets("Demographic").Range("AU" & i).Copy
Sheets("Employee import").Range("F" & i).PasteSpecial xlPasteValues
End If
i = i + 1
Next
'The following is searching each cell in a range to determine if a cell contains a "T". If the cell contains a "T", the macro will copy the value of a different column (same row) and paste it in to another worksheet (same row)
Set rng = Worksheets("Demographic").Range("AM2:AM" & lastRow)
i = "2"
For Each cell In rng
If cell.Value = "T" Then
Sheets("Demographic").Range("AO" & i).Copy
Sheets("Employee import").Range("G" & i).PasteSpecial xlPasteValues
End If
i = i + 1
Next

Answer 1

A formula array should be your best hope. This supposes that the cells that do not match will lead to empty values in the destination range:
chk = "Demographic!AU2:AU" & lastRow
src = "Demographic!AU2:AU" & lastRow
With Sheets("Employee import").Range("F2:F" & lastRow)
.FormulaArray = "=IF(" & chk & "<> """"," & src & ", """")"
.Value = .Value '<-- if you want to remove the formulas and keep only the copied values
End With
chk = "Demographic!AM2:AM" & lastRow
src = "Demographic!AO2:AO" & lastRow
With Sheets("Employee import").Range("G2:G" & lastRow)
.FormulaArray = "=IF(" & chk & "= ""T""," & src & ", """")"
.Value = .Value '<-- if you want to remove the formulas and keep only the copied values
End With
Not sure that it will be faster with your dataset though, you can only verify by trying it.

Answer 2

If you just want a straight data transfer (ie no formulas or formats), and your data set is large, then you could consider writing the data in one batch by way of an array.
Your own code shouldn't be horrendously slow though, so it suggests you have some calculations running or maybe you're handling Worksheet_Change events. If this is possible, then you might want to disable those during the data transfer:
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Just remember to reset them at the end of your routine:
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
If you went the array route, skeleton code would be like so:
Dim inData As Variant
Dim outData() As Variant
Dim r As Long
'Read the demographic data
With Worksheets("Demographic")
inData = .Range(.Cells(2, "AU"), .Cells(.Rows.Count, "AU").End(xlUp)).Value2
End With
'Use this if your column F is to be entirely overwritten
ReDim outData(1 To UBound(inData, 1), 1 To UBound(inData, 2))
'Use this if you have exisiting data in column F
'With Worksheets("Employee import")
' outData = .Cells(2, "F").Resize(UBound(inData, 1)).Value2
'End With
'Pass the values across
For r = 1 To UBound(inData, 1)
If Not IsEmpty(inData(r, 1)) Then
outData(r, 1) = inData(r, 1)
End If
Next
'Write the new values
Worksheets("Employee import").Cells(2, "F").Resize(UBound(outData, 1)).Value = outData

Answer 3

as for your first copy/paste values, it actually doesn't need any check, since blank values would be pasted as blank ones...
so you could go:
With Worksheets("Demographic")
With .Range("AU2", .Cells(.Rows.count, "AU").End(xlUp))
Worksheets("Employee import").Range("F2").Resize(.Rows.count).Value = .Value
End With
End With
as for your 2nd copy/paste values, you could paste all values and then filter not wanted ones and clear them in target sheet
like follows:
With Worksheets("Demographic")
With .Range("AM2", .Cells(.Rows.count, "AM").End(xlUp))
Worksheets("Employee import").Range("G2").Resize(.Rows.count).Value = .Offset(, 2).Value
End With
End With
With Worksheets("Employee import")
With .Range("G1", .Cells(.Rows.count, "G").End(xlUp))
.AutoFilter field:=1, Criteria1:="<>T"
.Resize(.Rows.count).Offset(1).SpecialCells(xlCellTypeVisible).ClearContents
End With
.AutoFilterMode = False
End With
that said, if your workbook has many formulas and/or event handlers then you would also greatly benefit from disabling them (Application.EnableEvents = False, Application.Calculation = xlCalculationManual) before running your code and enabling them back (Application.EnableEvents = True, Application.Calculation = xlCalculationAutomatic) after you code completes