Need to make the .find loop more efficient

arviy2k

Board Regular
Joined
Jan 1, 2010
Messages
53
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.

Code:
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
 

Some videos you may like

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.

Watch MrExcel Video

Forum statistics

Threads
1,102,152
Messages
5,485,058
Members
407,479
Latest member
jbone2020

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top