Is There a More Efficient Way to Code This?

R

reberryjr

Well-known Member
Joined
Mar 16, 2017
Messages
714
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

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
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 Question
Filter & Delete Deleting Header Row Suddenly
Replies
0
Views
457
reberryjr
R
R
  • Question Question
Updating Visible Cells
Replies
6
Views
349
rlv01
R
R
  • Solved
Code Opens File but Isn't Closing It
Replies
4
Views
411
reberryjr
R
R
  • Question Question
Identification and Reformatting of Dates
2
Replies
14
Views
896
Bosquedeguate
Bosquedeguate
Sean15
  • Question Question
Could you help improve recorded macro
2
Replies
13
Views
444
Sean15
Sean15

Forum statistics

Threads
1,223,897
Messages
6,175,270
Members
452,628
Latest member
dd2

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