Very Long Excecution Time

[DarkBox121]

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.

    '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

[si_the_geek]

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

Rather than using a column in the sheet, it would be quicker to use an array in your code.

If you don't know what an array is, see the article What are arrays and how do I use them? from our Classic VB FAQs (in the FAQ forum)


Reading/writing values for individual cells is relatively slow... if you are working with a group of cells (as you are in the "A" loop for example), it is much faster (about 5? times) to use an array instead.

To get data from the sheet into an array, you can use code like this:

Dim vArray As Variant
  vArray  = oXLSheet.Range("D7:E9").Value 

'example of reading from it
Dim lngCol as Long, lngRow as Long
  For lngRow = 1 To UBound(vArray,1)
    For lngCol = 1 To UBound(vArray,2)
      MsgBox vArray(lngRow, lngCol)
    Next lngCol
  Next lngRow

To put the data from the array back into the cells, use code this:

oXLSheet.Range("D7:E9").Value = vArray

As you are repeatedly using the cells in your code, working with the array rather than the cells should make a notice improvement.


The 'downside' to using an array for the data is that you can no longer use WorksheetFunction.CountIf and Cells.Replace, but that isn't really a bad thing because both of those methods are fairly slow - and one of them is only checking if the other needs to run (but still counting even after it has found the first), which could be done in a faster way by writing a bit more code.

Here is one way that your 'B' loop could be rewritten (even before switching to using an array) that should be quite a bit faster:

Dim booHaveDupe as Boolean
Dim strCellValue as String
Const c_strDupe as String = "06-TM-Dupe"
        For B = ALastRow To 1 Step -1
            strCellValue = Range("AF" & B).Value  
            'only do a search if not already marked as dupe
            If strCellValue <> c_strDupe Then  
              booHaveDupe = False
              'only search the cells above
              For C = B-1 To 1 Step -1  
                If Range("AF" & C).Value = strCellValue Then
                  'if a match is found, replace it, and note that there is a dupe
                  Range("AF" & C).Value = c_strDupe
                  booHaveDupe = True
                End If
              Next C
              If booHaveDupe Then
                'if any dupes were found, update the current cell too
                Range("AF" & B).Value = c_strDupe
              End If
            End If
        Next B

[Siddharth Rout]

A small help from my side....

To find duplicate values

http://www.vbforums.com/showthread.php?t=581525

You can amend it so that instead of showing the cell addresses, you can perform your task...

[DarkBox121]

I am going to give what both of you two have stated a fair shot. If I need help I'll be back to post about my struggles.