VBA is taking too long to give the output / using FIND function

[kevivu]

I have three sheets ( 1.GCBC 2.RHPOOLLVL 3.Comparison Summary) inside my excel file. My goal is to fill the sheet 3 ('comparison summary') from the values of sheets 1 & 2. following is the code i have written to achieve the results, this is working fine but taking hell lot of time to complete. Hence anyone please look into this and provide your valuable suggestion to improve the performance.

Sub Source_Comparison()


Dim SourceFile As Workbook
Dim SourceTab As Worksheet
Dim TargetTab As Worksheet
Dim SourceValidTab As Worksheet
Dim found As Range
Dim sht, sht1 As Worksheet
Dim LastRow, LastRow1 As Long
Dim LastColumn, LastColumn1 As Long
Dim StartCell, StartCell1 As Range
Dim MyTimer As Double


Application.ScreenUpdating = False
Application.DisplayAlerts = False


Set TargetTab = Sheets("Comparison Summary")


Sheets("GCBC").Select
Sheets("GCBC").Copy Before:=Sheets(1)
Sheets("GCBC (2)").Select
Sheets("GCBC (2)").Name = "GCBC_TEMP"


Set SourceTab = Sheets("GCBC_TEMP")
Sourcerow = SourceTab.Cells(SourceTab.Cells.Rows.Count, 1).End(xlUp).Row
Sourcecol = SourceTab.Cells(1, SourceTab.Cells.Columns.Count).End(xlToLeft).Column + 1
SourceTab.Activate


SourceTab.Cells(1, Sourcecol) = "RPTPRDPID"


Sheets("RHPOOLLVL").Select
Sheets("RHPOOLLVL").Copy Before:=Sheets(1)
Sheets("RHPOOLLVL (2)").Select
Sheets("RHPOOLLVL (2)").Name = "RHPOOLLVL_TEMP"


Set SourceValidTab = Sheets("RHPOOLLVL_TEMP")
SourceValidrow = SourceValidTab.Cells(SourceValidTab.Cells.Rows.Count, 1).End(xlUp).Row
SourceValidcol = SourceValidTab.Cells(1, SourceValidTab.Cells.Columns.Count).End(xlToLeft).Column + 1
SourceValidTab.Activate


SourceValidTab.Cells(1, SourceValidcol) = "RPTPRDVALIDPID"


L = TargetTab.Cells(TargetTab.Cells.Rows.Count, 1).End(xlUp).Row


For x = 2 To L


        RPTPRD = TargetTab.Cells(x, 4).Value
        Pid = TargetTab.Cells(x, 5).Value
        ValidId = CStr(RPTPRD) + CStr(Pid)
        SourceStartCol = 3
        SourceValidStartCol = 7
        
    For y = 7 To 150
    
        Set found = SourceTab.Rows.Find(ValidId, , , xlWhole, , , , False)
        If Not found Is Nothing Then
            RowIndex = found.Row
            TargetTab.Cells(x, y).Value = SourceTab.Cells(RowIndex, SourceStartCol).Value
        End If
        
        TargetTab.Cells(x, y + 1).Value = SourceValidTab.Cells(x, SourceValidStartCol).Value
        
        
        TargetTab.Cells(x, y + 2).Value = TargetTab.Cells(x, y).Value - TargetTab.Cells(x, y + 1).Value
        
            If TargetTab.Cells(x, y + 2).Value = 0 Then
               TargetTab.Cells(x, y + 3).Value = 0
            ElseIf TargetTab.Cells(x, y).Value = 0 Or IsNull(TargetTab.Cells(x, y).Value) Then
               TargetTab.Cells(x, y + 3).Value = "100"
            Else
               TargetTab.Cells(x, y + 3).Value = ((TargetTab.Cells(x, y + 2).Value) / TargetTab.Cells(x, y).Value) * 100
            End If


            If Abs(TargetTab.Cells(x, y + 3).Value) > 2 And Abs(TargetTab.Cells(x, y + 3).Value) < 10 Then
                TargetTab.Cells(x, y + 3).Interior.Color = 16711680
            ElseIf Abs(TargetTab.Cells(x, y + 3).Value) >= 10 And Abs(TargetTab.Cells(x, y + 3).Value) < 50 Then
                TargetTab.Cells(x, y + 3).Interior.Color = 65535
            ElseIf Abs(TargetTab.Cells(x, y + 3).Value) >= 50 Then
                TargetTab.Cells(x, y + 3).Interior.Color = 255
            Else
                TargetTab.Cells(x, y + 3).Interior.Color = 16777215
            End If
        
            
        SourceStartCol = SourceStartCol + 1
        SourceValidStartCol = SourceValidStartCol + 1
        y = y + 3
    
    Next y


    
 Next x




    Sheets("GCBC_TEMP").Select
    ActiveWindow.SelectedSheets.Delete


    Sheets("RHPOOLLVL_TEMP").Select
    ActiveWindow.SelectedSheets.Delete
    
Application.ScreenUpdating = True
Application.DisplayAlerts = True


MsgBox "Source Comparison Report Created"


End Sub