VBA so slow - Find & Replace

[Gazz_KW]

Hi folks, need some help from you guys again!


I have 2 sections of code looking for a blank cell in various columns...
(Finds the bottom most occupied cell in another column and starting from the bottom most blank cell, changes the blank into showing some text)

The first section of code works fine and is fast, whereas the section section works but takes a good few seconds for each line (as my data can contain over 2000 lines this is no good)

Any help would be most appreciated.

The Code -

'    ' ********** Manipulate TASKS CLOSED to show FSC Dept Name from Blank *****************
' ******* THIS SECTION OF CODE WORKS FINE AND IS FAST! ***************
    Sheets("Tasks Closed").Select ' select the sheet we want to work on
   
   ' Check for bottom of column B
    Columns("b:b").ColumnWidth = 8
    Range("b65536").End(xlUp).Select
    ActiveCell.Offset(0, 2).Select
    
    ' continue checking until gets to row 2
    While ActiveCell.Row > 1
    
    ' Replace a blank space with FSC
    ActiveCell.Replace What:="", Replacement:="FSC", LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=True, _
    ReplaceFormat:=False
    Application.FindFormat.Clear
    Selection.Replace What:="", Replacement:="FSC", LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
   ' move up a cell and check all over again
    ActiveCell.Offset(-1, 0).Select
    Wend
    
' ********** Manipulate TASKS CLOSED to show FSC Dept Number as "Supplier" from Blank *****************
' ******* THIS SECTION OF CODE WORKS BUT IS SO SLOW - WHY???? ***************

    Sheets("Tasks Closed").Select ' select the sheet we want to work on
   
   ' Check for bottom of column A
    Columns("a:a").ColumnWidth = 8
    Range("a65536").End(xlUp).Select
    ActiveCell.Offset(0, 2).Select
    
    ' continue checking until gets to row 2
    While ActiveCell.Row > 1
    
    ' Replace a blank space with Supplier
    ActiveCell.Replace What:="", Replacement:="Supplier"
    
' Various lines below changed to comments to see if it speeds up
    
    ', LookAt:=xlPart, _
    'SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=True, _
    'ReplaceFormat:=False
    'Application.FindFormat.Clear
    'Selection.Replace What:="", Replacement:="Supplier", LookAt:=xlPart, _
    'SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
    'ReplaceFormat:=False
    
   ' move up a cell and check all over again
    ActiveCell.Offset(-1, 0).Select
    Wend

 

[Norie]

Why are you looping through cell by cell?

Can't you do the find/replace on the entire range in one go?

 

[Gazz_KW]

Why are you looping through cell by cell?

Can't you do the find/replace on the entire range in one go?

Mainly because I have inherited this peice of code adn it worked on a previous task, also not sure how to do what you mention. (can you give me an example please)

Cheers

 

[Norie]

Something like this perhaps.

LastRow = Range("B" & Rows.Count).End(xlUp).Row
 
Range("B2:B" & LastRow).Replace What:="", Replacement:="FSC", LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=False