VBA - How to make For loop faster

user_14124396 0
Viewed 314

This loop takes about 2 minutes for 15 worksheets with each less than a hundred rows. Is there a faster way to do this?

For Each ws In Worksheets
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        ws.Cells(i, "H").Value = ws.Cells(i, "C").Value & ws.Cells(i, "A").Value
    Next i
Next
vba excel
3 Answers

Try this (not tested)

For Each ws In Worksheets
    With ws.Range("H2").Resize(ws.Cells(Rows.Count, "A").End(xlUp).Row - 1, 1)
        .Formula = "=C2&A2"
        .Value = .Value
    End With
Next

Also consider adding

Application.ScreenUpdating = False
Application.EnableEvents = False

to the beginning of your code and reset them to True at the end just in case you're triggering code in event callbacks.

user_133864200

Another approach could be to copy the data into arrays and write the arrays back but I am not sure if this is really faster than the appoach with formulas and then replacing the formulas with the values

Sub TestIt()
Dim i As Long
Dim ws As Worksheet
Dim aDat As Variant, cdat As Variant, hDat As Variant, lastRow As Long

    TurnOff
    For Each ws In Worksheets
        With ws
            lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            aDat = .Range("A2:A" & lastRow).Value2
            cdat = .Range("C2:C" & lastRow).Value2
            ReDim hDat(1 To lastRow, 1 To 1)
            For i = LBound(aDat) To UBound(aDat)
                hDat(i, 1) = aDat(i, 1) & cdat(i, 1)
            Next i
            .Range("H2:H" & lastRow).Value2 = hDat
    
        End With
    Next
    TurnOn
End Sub

Sub TurnOff()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
End Sub
Sub TurnOn()
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
End Sub
user_66009400

I hope this may help you to execute the macro faster.

Sub Macro1()

Dim ws As Worksheet, rCount As Integer, rng As Range

For Each ws In Worksheets
    rCount = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    ws.Range("H2").Formula = "=CONCATENATE(" & ws.Range("C2").Address(RowAbsolute:=False) & "," & ws.Range("A2").Address(RowAbsolute:=False) & ")"
    Set rng = ws.Range("H2:H" & rCount)
    ws.Range("H2").Copy
    rng.Select
    ws.Paste
    rng.Copy
    rng.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
Next

End Sub

Thanks, Ramana

user_20320810
Related