Is There a More Efficient Way to Code This?

R

reberryjr

Well-known Member
Joined
Mar 16, 2017
Messages
701
Office Version
  1. 365
Platform
  1. Windows
I'm curious if there is a more efficient way to code this. I ingest data from ~25 files; each with people's names formatted differently (sometimes w/in the same file). I cannot control the format of the files I get, so I'm having to use code to get the names in the format I want. I feel like there has to be a more efficient way to do this:
VBA Code: 
Sub IDDecisionerNames()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim m As Workbook
Dim mD As Worksheet, mV As Worksheet
Dim mDLR As Long
Dim c As Range

Set m = ThisWorkbook
Set mD = m.Sheets("Data")
Set mV = m.Sheets("Variables")

mDLR = mD.Range("C" & Rows.Count).End(xlUp).Row
mVLR = mV.Range("A" & Rows.Count).End(xlUp).Row

'mD.UsedRange.Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlYes

'******Prep Decisioner Lookup Columns******

mD.Range("H2:H" & mDLR).Value = "Pending Calc"

'Last, Pref First
mV.Range("O2:O" & mVLR).Value = "=IF(RC[-11]="""","""",RC[-9]&"", ""&RC[-11])"

'Last, Pref First & MI
mV.Range("P2:P" & mVLR).Value = "=IF(OR(RC[-11]="""",RC[-12]=""""),"""",RC[-10]&"", ""&RC[-12]&"" ""&LEFT(RC[-11],1))"

'Last, Legal First
mV.Range("Q2:Q" & mVLR).Value = "=RC[-11]&"", ""&RC[-14]"

'Last, Legal First & MI
mV.Range("R2:R" & mVLR).Value = "=IF(RC[-13]="""","""",RC[-12]&"", ""&RC[-15]&"" ""&LEFT(RC[-13],1))"

'Legal First & Last
mV.Range("S2:S" & mVLR).Value = "=PROPER(RC[-16])&"" ""&PROPER(RC[-13])"

'Middle & Last
mV.Range("T2:T" & mVLR).Value = "=IF(LEN(RC[-15])>1,RC[-15]&"" ""&RC[-14],"""")"
'Holder2
'Holder3
'Holder4
'Holder5
'Holder6
'Holder7
'Holder8
'Holder9
'Holder10

'First (Pref then Legal) & Last
mV.Range("AD2:AD" & mVLR).Value = "=IF(RC[-26]="""",PROPER(RC[-27]) & "" ""&PROPER(RC[-24]),PROPER(RC[-26])&"" ""&PROPER(RC[-24]))"

'******Begin Identifying Decisioner Info******

'Clean up Decisioner Identifier values.
For Each c In mD.Range("G2:G" & mDLR)
    With c
        .Replace What:=" [LOAN ADMINISTRATION MANAGER]", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        .Replace What:=" [REO ASSET RECOVERY MGR]", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        .Replace What:=" [PROPERTY ASSET MGMT MANAGER]", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        If c.Value = "" Then
            c.Offset(, 1).Value = "No Identifier"
        ElseIf c.Value = "0" Then
            c.Offset(, 1).Value = "No Identifier"
        ElseIf c.Value = "1" Then
            c.Offset(, 1).Value = "No Identifier"
        ElseIf c.Value = "None" Then
            c.Offset(, 1).Value = "No Identifier"
        ElseIf c.Value = "X" Then
            c.Offset(, 1).Value = "Delete Record"
        ElseIf Right(c, 1) = "." Then
            c.Value = Left(c.Value, Len(c.Value) - 1) 'Removes the "." at the end of the cell value.
        ElseIf Right(c, 1) = " " Then
            c.Value = Left(c.Value, Len(c.Value) - 1) 'Removes the " " at the end of the cell value.
        ElseIf Left(c, 1) = " " Then
            c.Value = Right(c.Value, Len(c.Value) - 1) 'Removes the " " at the beginning of the cell value.
        Else
            c.Offset(, 1).Value = "Pending Calc"
        End If
    End With
Next c
        
mD.UsedRange.AutoFilter Field:=8, Criteria1:="Pending Calc"

For Each c In mD.Range("G2:G" & mDLR).SpecialCells(xlCellTypeVisible)
    With c
        If c.Value = "Moreno" Then
            c.Offset(, 1).Value = "Momma Moreno"
        ElseIf c.Value = "Paxton" Then
            c.Offset(, 1).Value = "Poppa Paxton"
        ElseIf Right(c, 4) = ".com" Then
            c.Offset(, 1).Value = "=IFERROR(VLOOKUP(RC[-1],Variables!C[6]:C[22],17,FALSE),""Email Not Found"")" 'Vlookup against Email.
        ElseIf IsNumeric(c) = True Then
            c.Offset(, 1).Value = "=IFERROR(VLOOKUP(RC[-1],Variables!C:C[23],23,FALSE),""Employee ID Not Found"")" 'Vlookup against Employee ID.
        Else
            c.Offset(, 1).Value = "Pending Calc"
        End If
    End With
Next c
            
mD.UsedRange.AutoFilter Field:=8, Criteria1:="Pending Calc"

'Worker
For Each c In mD.Range("G2:G" & mDLR).SpecialCells(xlCellTypeVisible)
    With c
        c.Offset(, 1).Value = "=IFERROR(VLOOKUP(RC[-1],Variables!C[-7]:C[22],30,FALSE),""Pending Calc"")"
    End With
Next c

mD.UsedRange.AutoFilter Field:=8, Criteria1:="Pending Calc"

'Full Legal Name
For Each c In mD.Range("G2:G" & mDLR).SpecialCells(xlCellTypeVisible)
    With c
        c.Offset(, 1).Value = "=IFERROR(VLOOKUP(RC[-1],Variables!C[-6]:C[22],29,FALSE),""Pending Calc"")"
    End With
Next c

mD.UsedRange.AutoFilter Field:=8, Criteria1:="Pending Calc"

'Last, Legal First
For Each c In mD.Range("G2:G" & mDLR).SpecialCells(xlCellTypeVisible)
    With c
        c.Offset(, 1).Value = "=IFERROR(VLOOKUP(RC[-1],Variables!C[9]:C[22],14,FALSE),""Pending Calc"")"
    End With
Next c

mD.UsedRange.AutoFilter Field:=8, Criteria1:="Pending Calc"

'Legal First & Last
For Each c In mD.Range("G2:G" & mDLR).SpecialCells(xlCellTypeVisible)
    With c
        c.Offset(, 1).Value = "=IFERROR(VLOOKUP(RC[-1],Variables!C[11]:C[22],12,FALSE),""Pending Calc"")"
    End With
Next c

mD.UsedRange.AutoFilter Field:=8, Criteria1:="Pending Calc"
        
'Last, First, MI
For Each c In mD.Range("G2:G" & mDLR).SpecialCells(xlCellTypeVisible)
    With c
        c.Offset(, 1).Value = "=IFERROR(VLOOKUP(RC[-1],Variables!C[10]:C[22],13,FALSE),""Pending Calc"")"
    End With
Next c

mD.UsedRange.AutoFilter Field:=8, Criteria1:="Pending Calc"

'Last, Pref First, MI
For Each c In mD.Range("G2:G" & mDLR).SpecialCells(xlCellTypeVisible)
    With c
        c.Offset(, 1).Value = "=IFERROR(VLOOKUP(RC[-1],Variables!C[8]:C[22],15,FALSE),""Pending Calc"")"
    End With
Next c
            
mD.UsedRange.AutoFilter Field:=8, Criteria1:="Pending Calc"

'Last, Pref First
For Each c In mD.Range("G2:G" & mDLR).SpecialCells(xlCellTypeVisible)
    With c
        c.Offset(, 1).Value = "=IFERROR(VLOOKUP(RC[-1],Variables!C[7]:C[22],16,FALSE),""Pending Calc"")"
    End With
Next c

mD.UsedRange.AutoFilter Field:=8, Criteria1:="Pending Calc"

'Middle & Last
For Each c In mD.Range("G2:G" & mDLR).SpecialCells(xlCellTypeVisible)
    With c
        c.Offset(, 1).Value = "=IFERROR(VLOOKUP(RC[-1],Variables!C[12]:C[22],11,FALSE),""Pending Calc"")"
    End With
Next c

'mD.Sort.SortFields.Clear

mV.UsedRange.EntireColumn.AutoFit

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
You could make your code much more efficient by using variant arrays, probably 1000 times faster:
One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.

So instead of writing a loop which loops down a range copying one row at a time which will take along time if you have got 50000 rows it is much quicker to load the 50000 lines into a variant array ( one worksheet access), then copy the lines to a variant array and then write the array back to the worksheet, ( one worksheet access for each search that you are doing),

I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question
Filter & Delete Deleting Header Row Suddenly
Replies
0
Views
231
reberryjr
R
R
  • Question
Updating Visible Cells
Replies
6
Views
189
rlv01
R
R
  • Solved
Code Opens File but Isn't Closing It
Replies
4
Views
288
reberryjr
R
R
  • Question
Identification and Reformatting of Dates
2
Replies
14
Views
681
Bosquedeguate
Bosquedeguate
R
  • Solved
Scripting Dictionary and Next Without For Error
Replies
5
Views
375
Joe4
Joe4

Forum statistics

Threads
1,215,069
Messages
6,122,954
Members
449,095
Latest member
nmaske

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top