VBA Code Simplify the Check, Copy, Paste Loop

[OilEconomist]

Thanks in advance for any assistance. Is there a simpler faster way to perform the following task? I am finding the last row in a sheet which contains around 100k rows, then comparing the cells in each of two rows and performing a function. This code takes about 42 second to run.

Option Explicit
'***************************************************************************************************************
Public Sub Test()

'_______________________________________________________________________________________________________________
'Turn off alerts, screen updates, and automatic calculation
        'Turn off Display Alerts
            Application.DisplayAlerts = False

        'Turn off Screen Update
            Application.ScreenUpdating = False

        'Turn off Automatic Calculations
            Application.Calculation = xlManual
            


'_______________________________________________________________________________________________________________
'Dimensioning


    Dim j As Long
    Dim LastRow As Long

    Dim StartTime As Double
    Dim SecondsElapsed As Double

'_______________________________________________________________________________________________________________

 StartTime = Timer 'Remember time when macro starts

                    
Sheets("Sheet1").Activate
    
LastRow = Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
   
'Moving and adjusting columns
            'Column C move
              Range("C8:C" & LastRow).Cut Range("H8")
                
            'Column D copy and paste values and then move
                For j = 9 To LastRow
                    If Range("D" & j) <> "" Then Range("D" & j).Copy Range("E" & j)
                Next j

    
                Range("D8:D" & LastRow).Clear
                

'Determine how many seconds code took to run
  SecondsElapsed = Round(Timer - StartTime, 2)

'Notify user in seconds
    MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation


'_________________________________________________________________________________________________________________
'Turn on alerts, screen updates, and calculate
        'Turn On Display Alerts
            'Application.DisplayAlerts = True

        'Turn on Screen Update
            'Application.ScreenUpdating = True

        'Turn off Automatic Calculations
            'Calculate

'_________________________________________________________________________________________________________________
'Place the curser in cell



End Sub

 

[johnnyL]

I believe @footoo just gave you what you want @OilEconomist.

-5pts for the lack of timer code.

 

[OilEconomist]

Sub Test()
Dim col&, LastRow&, rng As Range
'Locate blank column to use as helper column
col = Range([A1], ActiveSheet.UsedRange).Columns.Count + 2
LastRow = Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
Set rng = Range("D9:D" & LastRow)
'Enter sequential numbers in helper column starting at row 9
rng.Offset(0, col - rng.Column) = Evaluate("ROW(1:" & LastRow & ")")
'Sort by column D to put blank cells at bottom
rng.EntireRow.Sort Key1:=[D9], Order1:=xlAscending, Header:=xlNo
Range("C9:C" & LastRow).Cut Range("H9")
On Error Resume Next
'Copy non-blank cells from column D to E
rng.SpecialCells(xlCellTypeConstants).Copy [E9]
On Error GoTo 0
'Sort data into original sequence
rng.EntireRow.Sort Key1:=Cells(9, col), Order1:=xlAscending, Header:=xlNo
'Delete helper column
Columns(col).Delete
End Sub

Thanks so much @footoo as this worked! Also thanks @johnnyL for your assistance.

 

[johnnyL]

I believe @footoo just gave you what you want @OilEconomist.

-5pts for the lack of timer code.

Upon further review, +4 pts awarded for commenting code.

Glad you got some code that you are happy with @OilEconomist. I am not done playing though.

 

[johnnyL]

@footoo hats off to a no loop solution and Extra thanks for commenting your code!!! I learned a couple things by stepping through your code. Thank you.

 

[footoo]

Thanks so much @footoo as this worked! Also thanks @johnnyL for your assistance.

What was the run-time?

 

[OilEconomist]

What was the run-time?

I think it was a second.