Excel VBA - Code working but really, really slowly

[justme101]

Hi Guys,

I have been an admirer of this forum since a long time and it has helped me a quite a lot but this time i had to post my query as i was getting nowhere through Google searches.

So, this table below is an example of my data set:

[TABLE="width: 320"]
<colgroup><col width="64" span="5" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl66, width: 64, align: center"]Obj1[/TD]
[TD="class: xl66, width: 64, align: center"]obj2[/TD]
[TD="class: xl66, width: 64, align: center"]obj3[/TD]
[TD="class: xl66, width: 64, align: center"]obj4[/TD]
[TD="class: xl66, width: 64, align: center"]obj5[/TD]
[/TR]
[TR]
[TD="class: xl65, align: center"]58894[/TD]
[TD="class: xl65, align: center"]123[/TD]
[TD="class: xl65, align: center"]54[/TD]
[TD="class: xl65, align: center"]222[/TD]
[TD="class: xl65, align: center"]1[/TD]
[/TR]
[TR]
[TD="class: xl65, align: center"]5667489[/TD]
[TD="class: xl65, align: center"]3345[/TD]
[TD="class: xl65, align: center"]123[/TD]
[TD="class: xl65, align: center"]1113[/TD]
[TD="class: xl65, align: center"]32[/TD]
[/TR]
[TR]
[TD="class: xl65, align: center"]534332[/TD]
[TD="class: xl65, align: center"]23[/TD]
[TD="class: xl65, align: center"]1123[/TD]
[TD="class: xl65, align: center"]3[/TD]
[TD="class: xl65, align: center"]414[/TD]
[/TR]
[TR]
[TD="class: xl65, align: center"]788890[/TD]
[TD="class: xl65, align: center"]500300[/TD]
[TD="class: xl65, align: center"]3234[/TD]
[TD="class: xl65, align: center"]31[/TD]
[TD="class: xl65, align: center"] [/TD]
[/TR]
[TR]
[TD="class: xl65, align: center"]716162[/TD]
[TD="class: xl65, align: center"]442[/TD]
[TD="class: xl65, align: center"]234234[/TD]
[TD="class: xl65, align: center"]2[/TD]
[TD="class: xl65, align: center"]1[/TD]
[/TR]
[TR]
[TD="class: xl65, align: center"]7234234[/TD]
[TD="class: xl65, align: center"]354[/TD]
[TD="class: xl65, align: center"]124[/TD]
[TD="class: xl65, align: center"]21324[/TD]
[TD="class: xl65, align: center"]23[/TD]
[/TR]
</tbody>[/TABLE]


There are 5 columns. What i need to do is check the first column (obj1) for values starting with "7". For all the ones that start with 7, i need to cut and paste data from adjacent cells to that cell. For e.g. the code runs and comes to row 4 (in above table) and finds that the value starts with 7 (788890). It CUTS the data from obj2 through obj5 and pastes it in column obj1 row4 itself. So, the data in row4 now becomes:

[TABLE="width: 320"]
<tbody>[TR]
[TD="class: xl66, width: 64, align: center"]Obj1[/TD]
[TD="class: xl66, width: 64, align: center"]obj2[/TD]
[TD="class: xl66, width: 64, align: center"]obj3[/TD]
[TD="class: xl66, width: 64, align: center"]obj4[/TD]
[TD="class: xl66, width: 64, align: center"]obj5[/TD]
[/TR]
</tbody>[/TABLE]

500300 3234 31

I did a lot of searching on google, as i am only an accountant and an enthusiast in the field of excel automation through macros/vba, and came up with this: (Line 2 in the code belows counts the used rows in Column O/Obj1 as it is the one containing the data in my file)

Sub formatdata()
1. Dim cel as Range, i as Long, j as Long
2. j = Cells(Rows.Count, "O").End(xlUp).Row
3. If (Left(Cells(i, "O").Value, 1)="7" Then
4. Cells(i, "O").Offset(,1).Resize(,5).Copy
5. Cells(i, "O").PasteSpecial xlPasteValues
6. Else
7. End If
8. Next i
End sub

This code seems to be working, but for each line to check and copy it takes about 2 seconds and i have the data in more than 36000 rows, which can go upto 70000 during critical reporting periods and waiting for so long would fail the purpose of writing a code for this.

Please help me to get a solution to speed this up or write this more efficiently. Thank you, in anticipation.

 

[Vbagreenhorn1]

The code you show can't work. Where is the FOR? There is also missing a )

 

[lrobbo314]

The following code should do what you're looking for very quickly.

Sub MoveEm()
Dim AR()
Dim LR As Long, LC As Long
Dim r As Range
LR = Cells(Rows.Count, "O").End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
Set r = Range("O2", Cells(LR, LC))
AR = r.Value
For i = 1 To UBound(AR)
    If Left(AR(i, 1), 1) = "7" Then
        For j = 1 To UBound(AR, 2) - 1
            AR(i, j) = AR(i, j + 1)
        Next j
        AR(i, j) = ""
    End If
Next i
r.Value = AR
    
End Sub

 

[Fluff]

Hi & welcome to the board
Here's another option

Sub Remove7()

    With Range("O2", Range("O" & Rows.Count).End(xlUp))
        .Value = Evaluate("if(left(" & .Address & ",1)=""7"",true," & .Address & ")")
        .SpecialCells(xlConstants, xlLogical).Delete xlToLeft
    End With
End Sub

 

[Vbagreenhorn1]

Sub Justme()
Dim I As Long
Application.ScreenUpdating = False
For I = 2 To Range("O" & Rows.Count).End(xlUp).Row
If InStr(Cells(I, 1), "7") = 1 Then
Cells(I, 15).Resize(, 4).Value = Cells(I, 15).Offset(, 1).Resize(, 4).Value
Cells(I, 19).ClearContents
End If
Next I
Application.ScreenUpdating = True
End Sub

 

[lrobbo314]

Hi & welcome to the board
Here's another option

Sub Remove7()

    With Range("O2", Range("O" & Rows.Count).End(xlUp))
        .Value = Evaluate("if(left(" & .Address & ",1)=""7"",true," & .Address & ")")
        .SpecialCells(xlConstants, xlLogical).Delete xlToLeft
    End With
End Sub

On test data with 300,000 rows of data, my version completes in 0.98 seconds and the version above took 3.027 seconds.

 

[Fluff]

On test data with 300,000 rows of data, my version completes in 0.98 seconds and the version above took 3.027 seconds.

@lrobbo314
Not quite sure what your point is. At no time did I mention anything about speed, I simply offered the OP another solution.
Also, bearing in mind that the OP stated

i have the data in more than 36000 rows, which can go up to 70000

I don't quite see the point in quoting speed tests on over 300times as much data.
That said, with that amount of data I'm not surprised that your solution is quicker. Whilst Specialcells can be very quick, if there are a lot of non-contiguous ranges, it can get quite slow.

 

[lrobbo314]

Well, seeing how the OP's main concern is speed, it seemed a salient bit of information.

 

[Fluff]

In that case on my test data of 80,000 rows, my code took .5 seconds & yours took 1.7
It entirely depends on the data
At the end of the day, both should be significantly quicker than the OP posted, giving him/her options.

 

[justme101]

The code you show can't work. Where is the FOR? There is also missing a )

To be honest i wrote this down on a paoer from my work PC. There's a lot of restrictions in place so i could not send the files via email to my personal id. I'll try your code though. Thank you.

@Irobbo314 @Fluff Thank you guys. I'll try this on monday and will update the status.