Need help speeding up my Macro

[Smilechild793]

Every time I run my macro, it takes about 1 min to execute. How can I fix this?

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

 

[igold]

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.

 

[Michael M]

Are there other macros involved here ??
Is "whichsheet" affected by any worksheet_change events ??

 

[Smilechild793]

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?

 

[Smilechild793]

I've created the below on sheet 1/Data Entry:

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:

Hope this helps!

 

[Michael M]

You didn't really answer any of our questions ??

 

[Michael M]

Upload the workbook to DropBox then post a link back here !

 

[Norie]

Try this.

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

 

[Smilechild793]

Upload the workbook to DropBox then post a link back here !

Sorry, I guess I'm not understanding the questions asked.

Here is the link: https://www.dropbox.com/s/z0xlxpfk6xq8ryn/Budget - FINAL.xlsm?dl=0

If there is a better way of doing something please let me know! I've been pulling my hair out trying to do this.

 

[Michael M]

Tried your workbook....runs instantly for me !!