I understand this is a long post and I apologize.

I will be using this thread for a while to aid me in speeding up not only this macro below but several others. I felt it important to explain what they all do briefly, when they are implemented, and why in order to have minimal confusion.

Weekly I am instructed to finalize a rather large Excel File containing all cell phone transactions that have occurred at several cell phone store locations. My task encompasses the following for all Service Numbers, SIM Numbers, and IMEI Numbers:

1. Finding and Labeling Blank Values
2. Finding and Labeling Duplicate Values
3. Finding and Labeling Flag Values
Note:
Flag Values are Values with an incorrect length. For example a 10 Digit Phone Number with only 5 Digits.

I am further instructed to complete these three tasks in the exact order listed above. Since the average amount of Rows (Individual Transactions) equate to approximately 5-10 Thousand per Weekly Report, my first thought was to create a Macro (or a list of Macros) that would speed this project up. I have successfully done so. My problem now is that it takes up to 1 Hour to complete.

I have over the past 3 months taught myself how to program Visual Basic in order to complete my task; therefore, in that respect I am quite new. I assume there are faster ways to complete what my supervisor has directed me to produce.

My Master Macro calls 4 Sub Macros and then calls another Master to complete another set of 4 Sub Macros. A total of 10 Macros exist for a total of 22 Printed Pages. That is too large to post.

On the other hand since all 4 Sub Macros are generally the same (one thing repeated 3 times with different Columns for all Service Numbers, SIM Numbers, and IMEI Numbers) by posting only 1 portion of each sub Step I am sure if any suggestions show up in this Thread I can apply them to all parts of the same step.

Below is the most time consuming step that exists in my Macro Set. This step will start with the Service Numbers and do the following:

1. Create a Column next to the Service Numbers (A Work Column)
2. Omit the Blank Values in the Work Column
3. Label All Duplicate Phone Numbers in the Work Column as "06-TM-Dupe"
4. Label All Duplicate Phone Numbers in the Service Number Column as "06-TM-Dupe"
5. Remove the Work Column

My logic behind this is that I have to create a work column since for several reasons:
Blank Values are already marked and I cannot mark them as Duplicates. I noticed that if I mark Blanks as Duplicate the Loop I run marks all of them as Duplicates not just the Service Number Column but the entire Worksheet.

Also, my Macro uses the Count Method and I noticed that since some numbers exceed 15 Digits (Special Phone Numbers, SIM Numbers, and IMEI Numbers) that my loop will end up labeling more Duplicates than needed. For Example, most SIM Numbers start with "890006021000" and end with different Numbers. My loop would mark "8900060210001111", "8900060210002222", and "89000602100023333" all as Duplicate Values in the SIM Number Column when obviously they are not.

In trying to find a solution to this, I noticed that a similarity between all (special) Service Numbers, SIM, and IMEI Numbers is that they start with the same 4 Numbers and all of them are not over 19 Digits. I can use the same loop for all of them but only on the last 15 digits.

Since I have to omit Blank Values and I need/have to only check the last 15 digits then I need a Work Column.

What I do:
Step 1:
I need to Omit the Blank Values first. I create a Work Column to do just this.

Then I run 1 loop to omit Blank Values entirely by labeling them as "Skip". Since the Value "Skip" does not exist anywhere within the entire Worksheet but the Work Column if that Value is Marked as a Duplicate Value it will not matter.

Step 2:
Now I can label Duplicate Values. I run a second loop to label the Duplicate Values for Service Numbers in bot the Work and the Service Number Column. (Phone Numbers do not exist anywhere but within those 2 Columns).

As I have stated in my 1st logical Step, not only will my Duplicate Loop mark Duplicate Values in 1 Column but the entire Worksheet. I assume this results from the Function I use; however, I need to use this Function since if I find 1 duplicate Value exists all Values must be marked as Duplicates. For example, if the number 111-111-1111 shows 5 times all 5 need to be marked as Duplicate Values.

Step 3:
Now have I have all duplicate Values Marked in both the Service Number and Work Column I compare the Work Column with the Service Number Column via Loop - if the Work Column Value is marked as Duplicate then its Marked as Duplicate in the Service Number Column. Once the loop is done then I remove the Column.

Code:
    'ACT/REACT Dupes Part 1 of 3: Service Number
        ' Copy of last 15 Digits of the into a Work Column
        Columns("AF:AF").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("AF1", Cells(ALastRow, 32)).Select
            With [AF1].CurrentRegion
                 [AF1] = "=RIGHT(RC[-1],15)"
                 Range([AF1], Cells(.Rows.Count, "AF")).FillDown
            End With
        Columns("AF:AF").Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
                Application.CutCopyMode = False
        ' Omits Blanks
        For A = ALastRow To 1 Step -1
            If Range("AE" & A).Value = "06-TM-Blank" Then
               Range("AF" & A).Value = "Skip"
            End If
        Next A
        ' Labeling the Duplicates in the Work Column
        For B = ALastRow To 1 Step -1
            If Application.WorksheetFunction.CountIf(Range("AF1:AF" & B), Range("AF" & B).Value) > 1 Then
                Cells.Replace what:=Range("AF" & B).Value, Replacement:="06-TM-Dupe", _
                LookAt:=xlWhole, SearchOrder:=xlByRows, _
                MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            End If
        Next B
        ' Remplacing Service Number Duplicates
        For C = ALastRow To 1 Step -1
            If Range("AE" & C).Value = "06-TM-Blank" Then
               Range("AF" & C).Value = "Skip"
            End If
            If Range("AF" & C).Value = "06-TM-Dupe" Then
               Range("AE" & C).Value = "06-TM-Dupe"
            End If
        Next C
        'Removes Work Column
        Columns("AF:AF").Delete Shift:=xlToLeft