VBA More effective way of data trimming

Question

My code consists of Split, Mid, Left, Right and Replace functions which are used to trim my data into a more neat manner. However, it's too long and inefficient, it takes too much time to go through all this because I have up to thousands of files that will go through this.

My main code goes through a folder and goes through all the files inside the folder to find and search for strings and then copy it out into a new worksheet.

'Test RowA(1)
wks.Cells(BlankRow, 1).Replace What:="testtest         : ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

---

'Start RowB(2)
wks.Cells(BlankRow, 2).Replace What:="  Started at: ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

---

'Temp RowC(3)
Dim strSearchC As String
Dim cCell As Range
Dim s3 As String
strSearchC = "testflyy"

Set cCell = wks.Cells(BlankRow, 3).Find(What:=strSearchC, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not cCell Is Nothing Then
s3 = Split(cCell.Value, ":")(1)
s3 = Mid(s3, 1, 3)
cCell.Value = s3
End If

---

'Type RowD(4)
Dim strSearchD As String
Dim dCell As Range
Dim s4 As String
strSearchD = "testflyy"

Set dCell = wks.Cells(BlankRow, 4).Find(What:=strSearchD, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not dCell Is Nothing Then
s4 = Split(dCell.Value, "_", 3)(2)
s4 = Mid(s4, 1, 3)
dCell.Value = s4
End If

---

'No RowF(6)
Dim strSearchF As String
Dim fCell As Range
Dim s6 As String
strSearchF = "homebeestrash_archivetestts"

Set fCell = wks.Cells(BlankRow, 6).Find(What:=strSearchF, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not fCell Is Nothing Then
s6 = Split(fCell.Value, "testts")(1)
s6 = Mid(s6, 1, 2)
fCell.Value = s6
End If

---

'End RowG(7)
Dim strSearchG As String
Dim gCell As Range
Dim s7 As String
strSearchG = "homebeestrash_archivetestts"

Set gCell = wks.Cells(BlankRow, 7).Find(What:=strSearchG, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not gCell Is Nothing Then
s7 = Split(gCell.Value, "reports")(1)
s7 = Split(s7, "Report")(0) 
s7 = Left(s7, 8) & " " & Right(s7, 6) 

---

'Month RowH(8)
wks.Cells(BlankRow, 8).Value = WorksheetFunction.Transpose(Left(s7, 4) & "-" & Mid(s7, 5, 2) & "-" & Mid(s7, 7, 2)) '<~~ get 2019-03-02
gCell.Value = s7
End If

Basically these are to trim the already extracted data in each respective rows worksheet, Row A and B is just simply replacing the data with nothing, for Row C onwards to Row H,, i will search if the string exists on the particular row and then use Split or Right, Left, Mid functions.

Question: Is there any other way to write it more efficiently because there are too many codings with formats like this and I feel like its slowing my program down a lot.

Answer 1

So I had a look at your code and I got confused to what you were trying to do with find. So I had to test it out for myself. If I understand it correctly you are using it to figure out if a string contains the value you are looking for. If it does you continue processing if not you skip it.

However, this can be done by fetching the cell value and performing InStr <> 0 to do the same thing.

I wrote a quick VBA to see the performance of find in relation to InStr. The results of this was (as you can test yourself now) that the .Find method took aproximately 5 seconds to compute, whereas the InStr one finishes instantly. When running on 100000 lines it takes almost a minute to complete, whereas the InStr one finishes instantly. So since you perform the Cells(x,y).Find for 4 separate columns in thousand of files I would say that this is your main culprit for timeloss.

Sheet1.Cells(1, 2).Value = TimeValue(Now)

For i = 0 To 10000
Dim x
Set x = Sheet1.Cells(1, 1).Find(What:="12", LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    If Not x Is Nothing Then
        Sheet1.Cells(1, 4) = "Yup"
    End If
Next i
Sheet1.Cells(1, 3).Value = TimeValue(Now)
Sheet1.Cells(2, 2).Value = TimeValue(Now)
For i = 0 To 10000
Set x = Sheet1.Cells(2, 1)
    If InStr(x, "12") <> 0 Then
        Sheet1.Cells(2, 4) = "Yup"
    End If
Next i
Sheet1.Cells(2, 3).Value = TimeValue(Now)

On top of that you are running Cells(x,y).Replace which is about twice as slow as just setting the value of the Replace as seen below.

wks.Cells(BlankRow, 1) = Replace(wks.Cells(BlankRow, 1),"string to remove","")

The methods you are running for Find and Replace are supposed to be executed on Ranges for the maximum efficiency. Say if you instead running replace on each cell one by one you execute it on the entire column straight away like this:

wks.Columns(1).Replace What:="testtest         : ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Then you will notice that the Replace is performed in less than a second for all rows. Making it a lot faster if you have massive files.