×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Faster Excel Macro

Faster Excel Macro

Faster Excel Macro

(OP)
How can I speed up this section of my macro?  I have enough data that this one part takes 45 min.  endRow ~ 18,000.  It just copies the part number into column A.  Original data looks something like this:

Drawing   12345
          abc
          def
23456     23456
          abc
junk
34567     34567
          abc
Drawing   45678

=====

    For k = 2 To endRow
        Cells(k, 1).Activate
        curCell = ActiveCell.Value
        firstCh = Left(curCell, 1)
        If ActiveCell.Value = "Drawing" Then
            pn = ActiveCell.Offset(0, 1).Value
        ElseIf firstCh = "1" Or _
                firstCh = "2" Or _
                firstCh = "3" Or _
                firstCh = "4" Or _
                firstCh = "5" Or _
                firstCh = "6" Or _
                firstCh = "7" Or _
                firstCh = "8" Or _
                firstCh = "9" Or _
                firstCh = "M" Then
            pn = ActiveCell.Value
        End If
        ActiveCell.Value = pn
    Next k

=====

When finished it looks like this:

12345     12345
12345     abc
12345     def
23456     23456
23456     abc
23456
34567     34567
34567     abc
45678     45678

RE: Faster Excel Macro

Hello,

No idea if this makes a difference, let me know, there is probably an even better/quicker way.


Application.ScreenUpdating = False
 For k = 2 To Range("A65536").End(xlUp).Row
        'Cells(k, 1).Activate
        'curCell = Cells(k, 1).Value
        firstCh = Left(Cells(k, 1), 1)
        If Cells(k, 1).Value = "Drawing" Then
            pn = Cells(k, 1).Offset(0, 1).Value
        ElseIf firstCh = "1" Or _
                firstCh = "2" Or _
                firstCh = "3" Or _
                firstCh = "4" Or _
                firstCh = "5" Or _
                firstCh = "6" Or _
                firstCh = "7" Or _
                firstCh = "8" Or _
                firstCh = "9" Or _
                firstCh = "M" Then
            pn = Cells(k, 1).Value
        End If
        Cells(k, 1).Value = pn
    Next k
Application.ScreenUpdating = True

----------------------------------
Hope this helps.
----------------------------------

maybe only a drafter
but the best user at this company!

RE: Faster Excel Macro

Hello,

Have come up with an alternative version, does this spped it up and is it still working as expected?


    Application.ScreenUpdating = False
    For k = 2 To Range("A65536").End(xlUp).Row
        If IsEmpty(Cells(k, 1).Value) Then GoTo CONT
        Range("G1").Value = Asc(Left(Cells(k, 1), 1))
        If Cells(k, 1).Value = "Drawing" Then
            pn = Cells(k, 1).Offset(0, 1).Value
        Else
            If Asc(Left(Cells(k, 1), 1)) >= 48 And Asc(Left(Cells(k, 1), 1)) <= 57 Or _
                Asc(Left(Cells(k, 1), 1)) = 77 Then pn = Cells(k, 1).Value
        End If
CONT:
        Cells(k, 1).Value = pn
    Next k
    Application.ScreenUpdating = True

----------------------------------
Hope this helps.
----------------------------------

maybe only a drafter
but the best user at this company!

RE: Faster Excel Macro

(OP)
I had already taken care of the Screen Updating.  I'm sure my problem is with the If checks, especially the 2nd.  I'll see what I can do with what you proposed.  One of my problems is not every cell in all 20 columns has something in it and it's not consistent either.  That's what I'm trying to fix, i.e. to group everything by part number.

RE: Faster Excel Macro

(OP)
Your version took 10 min longer.  It certainly looked faster anyway and I picked up some great techniques so your effort certainly wasn't wasted.

Most of the time I have to slightly modify code that gets written here.  Your's worked perfectly.  I must have done a better job describing what I needed than usual.

I found that 1/3 of the rows processed are completely blank.  I'll have someone go in and delete them.  That should cut down on the time considerably.

Roger

RE: Faster Excel Macro

If you have a large list of data where you wish to group by certain cell value you should look at a pivot table.

If you are familiar with this feature of excel i wont bother you if not please post back and i will broaden.

Best regards

Morten

RE: Faster Excel Macro

Just a couple of general suggestions.

1. Rather than re-evaluate the last row every time through the loop, do it once before the loop.

2. Only evaluate firstchr if you need to (test for "Drawing" first)

3. Use Select Case rather than multiple ElseIf...Or

4. To help optimise add a timer so you can see what's going on.

I've incorporated these suggestions here:

x = Timer

Application.ScreenUpdating = False
l = Range("A65536").End(xlUp).Row
 For k = 2 To l
        If Cells(k, 1).Value = "Drawing" Then
            pn = Cells(k, 1).Offset(0, 1).Value
        Else
           firstch = Left(Cells(k, 1), 1)
        Select Case firstch
        Case 1 - 9, "M"
                    pn = Cells(k, 1).Value
                    End Select
        End If
        Cells(k, 1).Value = pn
    Next k
Application.ScreenUpdating = True

y = Timer - x
MsgBox "Test took " & y & " secs"

Good Luck
johnwm
________________________________________________________
To get the best from these forums read FAQ731-376 before posting

RE: Faster Excel Macro

(OP)
Morten,

A pivot table is indeed just where I'm headed.  Can I make a pivot table pull data from 8 separate files with 20+ worksheets each?  If I can then I don't need this macro.  I guess I assumed that all the data had to be on one worksheet.  Obviously I've done very little with pivot tables.

Even then would a pivot table be able to associate line def with drawing 12345 in my example?

John,

I did use a time check but not Timer as you did.  Much more elegant, thanks.  I'll give this a try.

Roger

RE: Faster Excel Macro

(OP)
John,

I get a type mismatch error for the statement:

Case 1 - 9, "M"

I'm running Excel 97.  I tried Case 1 To 9, "M" and it errored also.

RE: Faster Excel Macro

wel in office 2000 you can make multiple ranges (havent used it myself so im not familiar with details).

This function can be called from VB - so that initially you can use the workbooks and sheets collections to find all sheets and the insert that into the funtion call (providing that each page has the same input field.

Best regards

Morten

RE: Faster Excel Macro

It works fine in Excel XP. Unfortunately I don't have a copy of 97 to test on. You could try replacing:

Case 1 - 9, "M"

with

Case "1" - "9", "M"

You can also trim the odd microsecond by replacing:

pn = Cells(k, 1).Offset(0, 1).Value

with

pn = Cells(k, 2).Value

Good Luck
johnwm
________________________________________________________
To get the best from these forums read FAQ731-376 before posting

RE: Faster Excel Macro

Hi Roger,
I decided to give a hard look at this. I repeated your data  in 20000 +rows in one worksheet, it takes about 2 seconds to organise with code given below. Have I overlooked anything?
I am using excel 2000 .

Application.ScreenUpdating = False
l = Range("A65536").End(xlUp).Row
 For k = 2 To l
        If Cells(k, 1).Offset(0, 1).Value = "" Then GoTo End1
        ' can use currentCell.EntireRow.Delete instead of GoTo End1
        If Cells(k, 1).Value = "Drawing" Then
            pn = Cells(k, 1).Offset(0, 1).Value
        Else
           firstch = Left(Cells(k, 1), 1)
        'Select Case firstch
        'Case 1 To 9, "M"
 ' use following two if if Case does not work        
            If Val(firstch) >= 1 And Val(firstch) <= 9 Then pn = Cells(k, 1).Value
            If firstch = "M" Then pn = Cells(k, 1).Value
                    'End Select

        End If
        Cells(k, 1).Value = pn
        
End1:
    Next k
Application.ScreenUpdating = True

y = Timer - x ' thanks john
MsgBox "Test took " & y & " secs "


You can also get rid of blank rows by serialising & sorting data before running any macro.

Use pivot tables after this organising . Look for help with 'consolidate multiple data ranges' to use data from many sheets.

best regards,
GK

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources