December 1, 2008 06:13pm pst

09.28.2008 at 03:53PM PDT, ID: 23770105

	[x] Attachment Details

[x]

The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

The Grade of the Solution
The Zone Rank of the Expert Providing the Solution
The Number of Author and Expert Comments
The Number of Experts Contributing
The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!

8.7

Need help with optimizing some VBA code - it's going too slow!

Asked by bluerocket in Microsoft Excel Spreadsheet Software

I have one worksheet with an id (incoming) and one worksheet with id plus phone number (vv1). In the process below, I need to do the following:

1) for each record in current, run through vv1. find a matching id if it exists.
2) if match, output the record to worksheet (archive).
3) if match, and phone number is unique, output the phone number to worksheet (current).

Problem is, this process is going much too slow. I have a feeling I'm not doing this the most effective way.

It's not an option to put formulas into the fields as the data is going to be swapped out on a constant basis. It all needs to be handled via VBA.

Thoughts?

Thanks.Start Free Trial

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:

           
           
             Public Sub RunPhoneifier()
 
Set w1 = Worksheets("incoming")
Set w2 = Worksheets("vv1")
Set w2a = Worksheets("vv2")
Set w3 = Worksheets("current")
Set w4 = Worksheets("archive")
 
w3.Cells.Clear
 
Dim r, c, r1, c1, r2, c2, r3, c3, r4, c4 As Integer
Dim regid, regid1, phone As String
Dim match As Boolean
 
w1ID = 1
'put in phone column # if incoming has a phone number
w2Phone = 1
w2ID = 2
 
With w1
    w1LR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
 
With w2
    w2LR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
 
With w2a
    w2aLR = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row + 1
End With
 
With w4
    w4LR = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row + 1
End With
 
Debug.Print w1LR
 
r1 = 2
r3 = 1
r3lr = 2
 
Do Until r1 >= w1LR
    regid = w1.Cells(r1, w1ID).Value
    Debug.Print regid
    r2 = 2
        Do Until r2 >= w2LR
            regid1 = w2.Cells(r2, w2ID).Value
            If regid1 = regid Then
            
                phone = w2.Cells(r2, w2Phone).Value
                w4.Cells(w4LR, 1).Value = regid
                w4.Cells(w4LR, 2).Value = phone
                w4.Cells(w4LR, 3).Value = Now()
                w4LR = w4LR + 1
                match = False
                
                Do Until r3 >= r3lr Or match = True
                    If phone = w3.Cells(r3, 1) Then
                    match = True
                    Else: r3 = r3 + 1
                    End If
                Loop
                
                If match = False Then
                    w3.Cells(r3lr, 1).Value = phone
                    r3lr = r3lr + 1
                End If
                r2 = w2LR
                
            Else: r2 = r2 + 1
            End If
        Loop
r1 = r1 + 1
Loop
 
 
 
End Sub

           
         

Keywords: Need help with optimizing some VBA c…

	Title
1	VBA "create new worksheets" code…
2	VBA for Conditional Formatting in Excel
3	simple vba or excel formula
4	Replace workbook name/worksheet …
5	Excel VBA Dynamic Formula question
6	Click on a cell and go to a different wo…

Loading Advertisement...

20081112-EE-VQP-42 - Hierarchy / EE_QW_2_20070628

1. zorvek 2,849,429
2. rorya 2,281,815
3. saurabh726 2,202,034
4. byundt 986,020
5. chris_bot... 936,272
6. nutsch 703,828
7. patrickab 570,747
8. brettdj 546,870
9. matthews... 497,834
10. webtubbs 445,798
11. jeverist 415,838
12. ahammar 362,441
13. spattewar 330,928
14. jpaulino 285,447
15. Psychotec 280,750
16. RobSamp... 279,314
17. epaclm 247,475
18. irudyk 241,776
19. dj88 216,941
20. WJReid 194,934
21. weellio 155,519
22. Merch_Ops 144,713
23. GrahamSkan 141,260
24. barryhou... 138,530
25. StellanRo... 131,168

1. zorvek 10,153,920
2. byundt 7,729,109
3. rorya 5,976,546
4. matthews... 3,060,962
5. jeverist 2,826,107
6. patrickab 2,326,310
7. saurabh726 2,295,613
8. roos01 1,923,578
9. brettdj 1,589,446
10. webtubbs 1,542,190
11. mvidas 1,529,753
12. fanpages 1,236,922
13. chris_bot... 1,125,778
14. MalicUK 1,060,396
15. nutsch 703,828
16. ahammar 662,574
17. mgh_mgh... 649,110
18. LoNeRaV... 602,049
19. ture 572,551
20. spattewar 539,877
21. R_Rajesh 468,975
22. jpaulino 398,346
23. david251 380,578
24. RobSamp... 377,863
25. gtgloner 350,884

Need help with optimizing some VBA code - it's going too slow!

Asked by bluerocket in Microsoft Excel Spreadsheet Software

About this solution