Need to make the .find loop more efficient

[arviy2k]

Hello everyone,

I've put together a code for below steps. However, I feel the procedure is too basic and there might be more efficient ways of doing the same. The present code is taking quite long, particularly the .find loop. I would really appreciate any help you can provide.

Procedure:

WLAsh is the source sheet
OMWsh is the destination worksheet

Step 1: In WLAsh, identify if column N of the row has a value of '1' (1,0,N/A). If value of 1 exists, take unique ID from column L
Step 2: In OMWsh, find the unique ID in the data (approx. 9000 rows for now). If ID exists and column AR is marked 'YES', do nothing - The find step is quite slow
Step 3: If ID exists and AR is not 'YES', then copy and paste relevant cells to the same row
Step 4: If ID does not exist, copy and paste relevant cells to the bottom of the data
Step 5: display a msgbox of the count of rows updated/added

The macro is fully functional, I've included some color coding to identify which rows were updated, but my coding experience is very limited and I'm hoping there's a faster/more streamlined way to do this.

Sub WLASOLupdate()Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False


'Declaring variables:
Dim WLA As Workbook     'WLA workbook
Dim OMW As Workbook     'OMW workbook
Dim WLAsh As Worksheet  'WLA Sheet
Dim OMWsh As Worksheet  'OMW Sheet
Dim Olastrow As Long    'OMW last row
Dim Wlastrow As Long    'WLA last row
Dim ofind As String     'Opportunity ID found in WLA
Dim orow As String      'row in OMW corresponding to ofind
Dim recCount As String  'already reconciled count
Dim updCount As String  'existing row updated count
Dim newCount As String  'new row added string


''CHANGE FILENAMES BELOW
Set WLA = Workbooks("Sols  WLA 6.30.16.xlsx")
Set OMW = Workbooks("Opportunity Management P1FY17WIP.xlsm")
Set WLAsh = WLA.Sheets("Consulting, AERS & FAS WLA")
Set OMWsh = OMW.Sheets("MasterData")


recCount = 0
updCount = 0
newCount = 0
'activating relevant sheets
WLAsh.Activate
OMWsh.Activate


    With WLAsh
        Wlastrow = .Range("A" & Rows.count).End(xlUp).Row
    End With
    With OMWsh
        Olastrow = .Range("A" & Rows.count).End(xlUp).Row
    End With


'change 120 to starting of query area in WLA sheet
For i = 120 To Wlastrow
    ' checking if Solution column is 1 and picking up Opp ID
    If WLAsh.Range("N" & i).Value = 1 Then
        ofind = WLAsh.Range("L" & i).Value
        ' checking if Opp already exists in OWM
        With OMWsh
            .Range("N1").Activate
            With .Range("N1:N" & Olastrow)
                On Error Resume Next
                orow = .Find(what:=ofind, LookIn:=xlValues, MatchCase:=False, searchformat:=False).Row
                On Error GoTo 0
            End With
                If Not orow = "" Then
                    .Range("A" & orow).Activate
                ' checking if row is reconciled
                    If .Range("AR" & orow).Value = "YES" Then
                        recCount = recCount + 1
                        .Range("A" & orow).Interior.ColorIndex = 34
                    Else
                ' updating row if not reconciled
                        updCount = updCount + 1
                        .Range("A" & orow).Interior.ColorIndex = 35
                        .Range("A" & orow).Value = WLAsh.Range("O" & i).Value
                        .Range("D" & orow).Value = WLAsh.Range("Q" & i).Value
                        .Range("E" & orow).Value = WLAsh.Range("H" & i).Value
                        .Range("F" & orow).Value = WLAsh.Range("I" & i).Value
                        .Range("G" & orow).Value = WLAsh.Range("S" & i).Value
                        .Range("H" & orow).Value = WLAsh.Range("T" & i).Value
                        .Range("I" & orow).Value = WLAsh.Range("C" & i).Value
                        .Range("J" & orow).Value = WLAsh.Range("E" & i).Value
                        .Range("K" & orow).Value = WLAsh.Range("G" & i).Value
                        .Range("L" & orow).Value = WLAsh.Range("M" & i).Value
                        .Range("M" & orow).Value = WLAsh.Range("K" & i).Value
                        '.Range("N" & orow).Value = WLAsh.Range("L" & i).Value
                        .Range("O" & orow).Value = WLAsh.Range("J" & i).Value
                        .Range("P" & orow).Value = WLAsh.Range("Z" & i).Value
                    End If
                Else
                ' adding new row if opportunity ID is not found
                    newCount = newCount + 1
                    Olastrow = Olastrow + 1
                    orow = Olastrow
                        .Range("A" & orow).Interior.ColorIndex = 36
                        .Range("A" & orow).Value = WLAsh.Range("O" & i).Value
                        .Range("D" & orow).Value = WLAsh.Range("Q" & i).Value
                        .Range("E" & orow).Value = WLAsh.Range("H" & i).Value
                        .Range("F" & orow).Value = WLAsh.Range("I" & i).Value
                        .Range("G" & orow).Value = WLAsh.Range("S" & i).Value
                        .Range("H" & orow).Value = WLAsh.Range("T" & i).Value
                        .Range("I" & orow).Value = WLAsh.Range("C" & i).Value
                        .Range("J" & orow).Value = WLAsh.Range("E" & i).Value
                        .Range("K" & orow).Value = WLAsh.Range("G" & i).Value
                        .Range("L" & orow).Value = WLAsh.Range("M" & i).Value
                        .Range("M" & orow).Value = WLAsh.Range("K" & i).Value
                        .Range("N" & orow) = WLAsh.Range("L" & i)
                        .Range("O" & orow).Value = WLAsh.Range("J" & i).Value
                        .Range("P" & orow).Value = WLAsh.Range("Z" & i).Value
                End If
                
        End With
    End If


ofind = vbNullString
orow = vbNullString


Next i


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox recCount & " rows already reconciled" & vbNewLine & updCount & " existing rows updated" & vbNewLine & newCount & " new rows created"


End Sub

Thank you!
ArvindYoga