VBA- cleaning up code/making it more efficient

[ffionnah]

Hi everyone,
Thank you, in advance, for any help!


I jumbled together this code which does what I want, however, it is very slow. Could you please help me to identify how I can make this more efficient and effective?

I have multiple spreadsheets with similar and different data, that needs to be all organized under the same headers. Most of the datasets have different headers, so I need to rename headers before moving columns. Anything that is different from the headers I am purposefully organizing, will be moved to the end of the columns.


Focused headers, in this order:
"Unqiue ID", "PATFRSNME", "PATLSTNME", "DOB", "PT ID", "Rx Number", "Date Submitted", "Written Date", "Refill", "Cont Phar(Y/N)", "ccc Location (Y/N)", "In Scope? (Y/N)", "EMR", "Encounter Date", "NDC", "Description", "Qty", "BIN", "PCN", "GROUPID", "Payer", "Program?", "NPI", "PRESLSTNME", "Sign Off", "Dispensed or Reversed", "Revision/Edits Needed", "Confirmed:", "Date", "Error", "Notes", "Location", "Cont Phar Name", "NABPNUM", "Phar Address", "Phar City"

Sub MoveDataMont()


Rows("1:6").Delete
Application.CutCopyMode = False ' don't want an existing operation to interfere
Columns("C").Insert XlDirection.xlToRight
Columns("C").Value = Columns("T").Value
Columns("T").Delete


Application.CutCopyMode = False ' don't want an existing operation to interfere
Columns("A").Insert XlDirection.xlToRight
Columns("A").Value = Columns("B").Value


Application.CutCopyMode = False ' don't want an existing operation to interfere
Columns("B").Insert XlDirection.xlToRight
Columns("B").Value = Columns("C").Value


Cells.Replace What:="NDC 11", _
                            Replacement:="NDC", _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            MatchCase:=False, _
                            SearchFormat:=False, _
                            ReplaceFormat:=True
Cells.Replace What:="Payer Type", _
                            Replacement:="Payer", _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            MatchCase:=False, _
                            SearchFormat:=False, _
                            ReplaceFormat:=True


Columns("A").Replace What:=",*", _
                            Replacement:="", _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            MatchCase:=False, _
                            SearchFormat:=False, _
                            ReplaceFormat:=True
Cells(1, 1).Value = "PATLSTNME"
                            
Columns("B").Replace What:="*,", _
                            Replacement:="", _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            MatchCase:=False, _
                            SearchFormat:=False, _
                            ReplaceFormat:=True
                           Columns("C").Delete
Cells(1, 2).Value = "PATFRSNME"




Cells(1, 3).Value = "DOB"
Cells(1, 4).Value = "PT ID"
Cells(1, 5).Value = "PRESLSTNME"
Cells(1, 8).Value = "Cont Phar Name"
Cells(1, 9).Value = "Rx Number"
Cells(1, 10).Value = "Refill"
Cells(1, 12).Value = "Written Date"
Cells(1, 14).Value = "Date Submitted"
Cells(1, 22).Value = "Description"
Cells(1, 28).Value = "Qty"


                         


Columns("A").Insert XlDirection.xlToLeft
Cells(1, 1).Value = "Unqiue ID"


Columns("J:N").Insert XlDirection.xlToLeft
Columns("R:T").Insert XlDirection.xlToLeft
Columns("V").Insert XlDirection.xlToLeft
Columns("Y:AF").Insert XlDirection.xlToLeft
Columns("AH").Insert XlDirection.xlToLeft
Cells(1, 10).Value = "Cont Phar (Y/N)"
Cells(1, 11).Value = "ccc Location (Y/N)"
Cells(1, 12).Value = "In Scope?"
Cells(1, 13).Value = "EMR"
Cells(1, 14).Value = "Encounter Date"
Cells(1, 18).Value = "BIN"
Cells(1, 19).Value = "PCN"
Cells(1, 20).Value = "GROUPID"
Cells(1, 22).Value = "Program?"
Cells(1, 25).Value = "Sign Off"
Cells(1, 26).Value = "Dispensed or Reversed)"
Cells(1, 27).Value = "Revision/Edits Needed"
Cells(1, 28).Value = "Confirmed By:"
Cells(1, 29).Value = "Date"
Cells(1, 30).Value = "Error"
Cells(1, 31).Value = "Notes"
Cells(1, 32).Value = "Location"
Cells(1, 34).Value = "NABPNUM"
Columns("AK:AW").Insert XlDirection.xlToRight




Cells(1, 37).Value = "Phar City"
Cells(1, 38).Value = "Pro City"
Cells(1, 39).Value = "Pro City"
Cells(1, 40).Value = "PO Number"
Cells(1, 41).Value = "PO Repl Date"
Cells(1, 42).Value = "Inv Number"
Cells(1, 43).Value = "Location SRC"
Cells(1, 44).Value = "Location Address Final"
Cells(1, 45).Value = "Location Final"
Cells(1, 46).Value = "ADDRESS SORTING"
Cells(1, 47).Value = "Location Verified"
Cells(1, 48).Value = "prefilled"
Cells(1, 49).Value = "RXCLAIM"


Cells.Replace What:="Phar Intersection", _
                            Replacement:="Phar Address", _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            MatchCase:=False, _
                            SearchFormat:=False, _
                            ReplaceFormat:=True






With Application.ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
Application.ActiveWindow.FreezePanes = True
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1").AutoFilter
End If


Dim v As Variant, x As Variant, findfield As Variant
Dim oCell As Range
Dim iNum As Long
v = Array("Unqiue ID", "PATFRSNME", "PATLSTNME", "DOB", "PT ID", "Rx Number", "Date Submitted", "Written Date", "Refill", "Cont Phar (Y/N)", "ccc Location (Y/N)", "In Scope? (Y/N)", "EMR", "Encounter Date", "NDC", "Description", "Qty", "BIN", "PCN", "GROUPID", "Payer", "Program?", "NPI", "PRESLSTNME", "Sign Off", "Dispensed or Reversed", "Revision/Edits Needed", "Confirmed:", "Date", "Error", "Notes", "Location", "Cont Phar Name", "NABPNUM", "Phar Address", "Phar City")
For x = LBound(v) To UBound(v)
findfield = v(x)
iNum = iNum + 1
Set oCell = ActiveSheet.Rows(1).Find(What:=findfield, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not oCell.Column = iNum Then
Columns(oCell.Column).Cut
Columns(iNum).Insert Shift:=xlToRight
End If
Next x






End Sub

 

[Ruddles]

How about sprinkling a few Debug.Print Format(Now(),"hh:mm:ss") statements at the top and the bottom, and between the main blocks of code, then check the Immediate window to see which bit of code is taking all the time?