Need help speeding up my Macro

Smilechild793

New Member
Joined
Apr 27, 2017
Messages
20
Every time I run my macro, it takes about 1 min to execute. How can I fix this?

Code:
Sub Button1_Click()Dim myRange As Range
Set myRange = ThisWorkbook.Worksheets("Data Entry").Range("Data")
Dim lastrow As Long
Dim whichsheet As String
whichsheet = InputBox("In which sheet do you wish to enter data?", "Sheet Number")
    If whichsheet = "" Then
    MsgBox "You didn't specify a sheet!"
    Exit Sub
    End If


lastrow = Sheets(whichsheet).Cells(Rows.Count, 1).End(xlUp).Row + 1
With Sheets(whichsheet)


'Add "Input By"
.Cells(lastrow, 1).Value = Sheets("Data Entry").Cells(21, 4).Value


'Add "On Behalf of"
.Cells(lastrow, 2).Value = Sheets("Data Entry").Cells(21, 8).Value


'Add "Date"
.Cells(lastrow, 3).Value = Sheets("Data Entry").Cells(19, 4).Value


'Add "Amount to Expense"
.Cells(lastrow, 9).Value = Sheets("Data Entry").Cells(25, 4).Value


'Add "Vendor"
.Cells(lastrow, 5).Value = Sheets("Data Entry").Cells(27, 4).Value


'Add "Invoice #"
.Cells(lastrow, 6).Value = Sheets("Data Entry").Cells(29, 4).Value


'Add "Cost Category"
.Cells(lastrow, 7).Value = Sheets("Data Entry").Cells(25, 8).Value


'Add "Description"
.Cells(lastrow, 8).Value = Sheets("Data Entry").Cells(27, 8).Value


End With


'Unload Data Entry Form
myRange.ClearContents


Exit Sub
End Sub
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Hi,

Unless I am missing something (which is completely in the realm), if this code is taking a minute to run, then there is something else going on with your workbook. You are only reading from and writing to eight different cells from two sheets.

Yes, the code could run quicker if you didn't keep going back and forth with the sheets to read and write data, but unless you have left off a portion of the code for brevity, this code as written should run in a split second.

I hope this helps.
 
Upvote 0
Are there other macros involved here ??
Is "whichsheet" affected by any worksheet_change events ??
 
Upvote 0
Hi,

Unless I am missing something (which is completely in the realm), if this code is taking a minute to run, then there is something else going on with your workbook. You are only reading from and writing to eight different cells from two sheets.

Yes, the code could run quicker if you didn't keep going back and forth with the sheets to read and write data, but unless you have left off a portion of the code for brevity, this code as written should run in a split second.

I hope this helps.

I have formulas on the sheet.. maybe that is why? Could I send you the workbook to view?
 
Upvote 0
I've created the below on sheet 1/Data Entry:
io3ryu.png


The green section is where people can enter their invoices, which get sent to sheet 3/Data Input (Input by, on behalf of, and cost category are data validation lists).

The blue section is for them to be able to quickly summarize their budget (Person and cost category are data validation lists, and the other 3 grayed out boxes are formulas referencing my Data Summary Sheet seen below:


14lpzlt.png


Hope this helps!
 
Upvote 0
You didn't really answer any of our questions ??
 
Upvote 0
Upload the workbook to DropBox then post a link back here !
 
Upvote 0
Try this.
Code:
Sub Button1_Click()
Dim myRange As Range
Dim lastrow As Long
Dim whichsheet As String
    
    Set myRange = ThisWorkbook.Worksheets("Data Entry").Range("Data")
    
    whichsheet = InputBox("In which sheet do you wish to enter data?", "Sheet Number")
    
    If whichsheet = "" Then
        MsgBox "You didn't specify a sheet!"
        Exit Sub
    End If

    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    lastrow = Sheets(whichsheet).Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    With Sheets(whichsheet)

        'Add "Input By"
        .Cells(lastrow, 1).Value = Sheets("Data Entry").Cells(21, 4).Value

        'Add "On Behalf of"
        .Cells(lastrow, 2).Value = Sheets("Data Entry").Cells(21, 8).Value

        'Add "Date"
        .Cells(lastrow, 3).Value = Sheets("Data Entry").Cells(19, 4).Value

        'Add "Amount to Expense"
        .Cells(lastrow, 9).Value = Sheets("Data Entry").Cells(25, 4).Value

        'Add "Vendor"
        .Cells(lastrow, 5).Value = Sheets("Data Entry").Cells(27, 4).Value

        'Add "Invoice #"
        .Cells(lastrow, 6).Value = Sheets("Data Entry").Cells(29, 4).Value

        'Add "Cost Category"
        .Cells(lastrow, 7).Value = Sheets("Data Entry").Cells(25, 8).Value

        'Add "Description"
        .Cells(lastrow, 8).Value = Sheets("Data Entry").Cells(27, 8).Value

    End With

    'Unload Data Entry Form
    myRange.ClearContents

    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
Tried your workbook....runs instantly for me !!
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,206
Members
452,618
Latest member
Tam84

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top