Repeat fill on header

[Jim G]

I have a report that has an account header in ColB followed by several rows
of data in ColF. The header is an account number and description such as
"4100 Sales". At the end of the data I have a Total for that account. The
following code works to extract the number from the header and repeat it for
each line of data related to that header in Col A. The code works but is
very slow. Can anyone suggest an improvement to speed it up over 3500 to
4500 rows.

Sub FillHelper()

Dim lLastRow As Long, lRow As Long
Dim sAccName As String

Sheets("GL").Select
With ActiveSheet
Range("F3").Select
lLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

lRow = 2

Do While lRow <= lLastRow
If Trim(.Cells(lRow, "B")) <> "" Then sAccName = .Cells(lRow, "B")

If Len(Trim(.Cells(lRow, "B"))) = 0 Then .Cells(lRow, "A") =
Left(sAccName, 4)

lRow = lRow + 1

Loop
End With
End Sub

I must acknowledge that this is an adaptation of a solution provided by
Nigel to a previous question in July.

Cheers

 

[Joel]

I would try to disple screenupdating and other events in the workbook while
the code is running

Sub FillHelper()

Application.EnableEvents = False
Application.ScreenUpdating = False

'enter you code here

Application.EnableEvents = True
Application.ScreenUpdating = True


exit sub

 

[Jim G]

I think you told me once that all macros should include this...Thanks for the
reminder. Worked perfectly.

Thanks