VBA: Speed Up Macro - Potential Array Help/Ideas

[bt_24]

Hi All,


Synopsis = This code currently works using filters but takes ~5 seconds to loop through each item which is not very helpful when there are thousands of rows. I am looking for any ideas on how to speed up this code - my thought is that this would be possible with arrays but I am pretty lost. Almost all of my coding experience involves Googling the answer until I find something applicable. I would really appreciate any advice or even pointing me in the right direction. When drafting this post the first time I had blinded everything to try and make it easier to follow but got logged off just before posting - didn't want to do that again so apologies if it is hard to follow.

This code works with 2 sheets. Sheet 1 has results that need to removed from the data in sheet 2. It is able to find the same item in sheet 2 because of a unique ID. The code starts at the first row in sheet 1 stores the data, applies a filter of sheet2 and then edits that data - looping through to the last row on sheet 1.

Below is the full code - most of it is just declarations and a few file edits at the beginning of the code. The loop is located near the end of the code that i think is the slowest part. Thank you for any help - I am looking forward to learning something new.

Option Explicit
Sub do_something ()

Application.ScreenUpdating = False
Application.DisplayAlerts = False


 Dim AdWordsFile As Workbook
 
 Dim AdWordsData As Worksheet
 Dim DS3Data As Worksheet
 
    Set AdWordsFile = ThisWorkbook
    Set AdWordsData = AdWordsFile.Sheets("AdWords Data") '**MAY CHANGE TO INEX AND REFERENCE NEW WB
    Set DS3Data = AdWordsFile.Sheets("DS Data")




'using this vs hard declare to row with customparam and last col as error handler and for future use
Dim cParamSpot As Integer ' column that had the row needed to run formula
Dim cTypeSpot As Integer 'incase click type changes location
Dim clickSpot As Integer 'custom location of clicks
Dim imprSpot As Integer
Dim costSpot As Integer
Dim lcol As Long 'last used column + 1 so that we can use lcol for formula
Dim lrow As Long 'last used row so I can delete the totals on the last 5 rows of adwords file


     cTypeSpot = AdWordsData.Range("A2:ZZ2").Find("Click type").Column
     clickSpot = AdWordsData.Range("A2:ZZ2").Find("Clicks").Column
     imprSpot = AdWordsData.Range("A2:ZZ2").Find("Impressions").Column
     costSpot = AdWordsData.Range("A2:ZZ2").Find("Cost").Column
     lcol = AdWordsData.Range("A2").End(xlToRight).Column + 1 'might not be the most stable but it is working
     lrow = AdWordsData.Range("A2").End(xlDown).Row
     
     'this section is delteing unecessary data - headline & sl plus phone with 0 clicks
     AdWordsData.Rows(lrow - 4 & ":" & lrow).Delete 'need minus 4 not 5 because lrow is also included **fix to use filter to delete
     lrow = AdWordsData.Range("A2").End(xlDown).Row 'need to redim lrow after deleting stuff
     
     With Range(AdWordsData.Cells(2, 1), AdWordsData.Cells(lrow, lcol))
        .AutoFilter Field:=cTypeSpot, Criteria1:=Array("Headline", "Sitelink"), Operator:=xlFilterValues
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter
     End With
     
    lrow = AdWordsData.Range("A2").End(xlDown).Row 'need to redim lrow after deleting stuff
    
     
     'this section creates a row at the end for the unique kw id
     AdWordsData.Cells(2, lcol).Formula = "KW ID"
     
     'using with and row and column to insert mid function to get kw id and should be dynamic
     With Range(AdWordsData.Cells(3, lcol), AdWordsData.Cells(lrow, lcol))
        .FormulaR1C1 = "=mid(rc[-1],18,17)"
     End With

Dim dsKwIDSpot As Integer
Dim dsClickSpot As Integer
Dim dsImprSpot As Integer
Dim dsCostSpot As Integer
Dim dsCPCspot As Integer
Dim dsCTRspot As Integer
    dsKwIDSpot = DS3Data.Range("A1:ZZ2").Find("Keyword ID").Column '**NOTE = should probably make this range dynamic also but oh well
    dsClickSpot = DS3Data.Range("A1:ZZ2").Find("Clicks").Column
    dsImprSpot = DS3Data.Range("A1:ZZ2").Find("Impr").Column
    dsCostSpot = DS3Data.Range("A1:ZZ2").Find("Cost").Column
    
    
'---------sections above are mostly used to clean file and find column headers dynamically
'---------below is the actual work zone and loop
    
'looping through cleaned adwords file and editing the ds version
Dim i As Integer 'declared in the loop, using for to vs do while
Dim adwordsImprVal As Long
Dim adwordsClickVal As Long
Dim adwordsCostVal As Double
Dim adwordsKwID As String 'cell value is a string if using long get the overflow error - value for kw need to be this

Dim dsImprVal As Long
Dim dsClickVal As Long
Dim dsCostVal As Double
Dim dsKwId As String

Dim x As Long

Dim dslRow As Long: Dim dslCol As Long
    dslRow = DS3Data.Range("A1").End(xlDown).Row
    dslCol = DS3Data.Range("A1").End(xlToRight).Column
    
    For i = 3 To lrow
        adwordsImprVal = AdWordsData.Cells(i, imprSpot).Value
        adwordsClickVal = AdWordsData.Cells(i, clickSpot).Value
        adwordsCostVal = AdWordsData.Cells(i, costSpot).Value
        adwordsKwID = AdWordsData.Cells(i, lcol).Value
        
        With Range(DS3Data.Cells(1, 1), DS3Data.Cells(dslRow, dslCol))
            .AutoFilter Field:=dsKwIDSpot, Criteria1:=adwordsKwID
            .Offset(1, 0).SpecialCells (xlCellTypeVisible)
                x = DS3Data.Range("A1").End(xlDown).Row 'creating this var because its a cheat way to only get active lrow
                
                dsImprVal = DS3Data.Range("A1").Offset(x - 1, dsImprSpot - 1).Value 'not totally sure why the -1 are needed
                dsClickVal = DS3Data.Range("A1").Offset(x - 1, dsClickSpot - 1).Value
                dsCostVal = DS3Data.Range("A1").Offset(x - 1, dsCostSpot - 1).Value
                
                'this feels hacky probably a better way delcaring variable first but ...
                DS3Data.Range("A1").Offset(x - 1, dsImprSpot - 1).Value = dsImprVal - adwordsImprVal
                DS3Data.Range("A1").Offset(x - 1, dsClickSpot - 1).Value = dsClickVal - adwordsClickVal
                DS3Data.Range("A1").Offset(x - 1, dsCostSpot - 1).Value = dsCostVal - adwordsCostVal
           
            .AutoFilter 'this should remove the filter before the next loop
        End With
        Debug.Print i
    Next
    
MsgBox ("All Done")

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub