Code Runs very slow using excel 2016

[teebee101]

I have 2 sheets, database & main, transferring data from Main to the very last row of database, then clear the transferred data from sheet main, also tried to sort the database by date, but became even slower. Am I doing something wrong? Thank You

Sub over()

Sheets("Main").Unprotect
Sheets("Database").Unprotect
Application.ScreenUpdating = False

TEMPLATE_SHEET = "main"
DATABASE_SHEET = "Database"
COUNT_ROw = 1
Database_Records = Sheets("DATABASE").Range("A1:A1000")

'To identify the next blank row in the database sheet

For Each DBRECORD In Database_Records

If DBRECORD <> "" Then COUNT_ROw = COUNT_ROw + 1

Next DBRECORD
'To copy the data from the template to the database

Sheets("main").Select

Range("Date").Copy
Sheets(DATABASE_SHEET).Range("A" & COUNT_ROw).PasteSpecial xlPasteValues
Range("RegVol").Copy
Sheets(DATABASE_SHEET).Range("B" & COUNT_ROw).PasteSpecial xlPasteValues
Range("SpecVol").Copy
Sheets(DATABASE_SHEET).Range("C" & COUNT_ROw).PasteSpecial xlPasteValues
Range("SupVol").Copy
Sheets(DATABASE_SHEET).Range("D" & COUNT_ROw).PasteSpecial xlPasteValues
Range("DVol").Copy
Sheets(DATABASE_SHEET).Range("E" & COUNT_ROw).PasteSpecial xlPasteValues
Range("RegSales").Copy
Sheets(DATABASE_SHEET).Range("F" & COUNT_ROw).PasteSpecial xlPasteValues
Range("SpecSales").Copy
Sheets(DATABASE_SHEET).Range("G" & COUNT_ROw).PasteSpecial xlPasteValues
Range("SupSales").Copy
Sheets(DATABASE_SHEET).Range("H" & COUNT_ROw).PasteSpecial xlPasteValues
Range("DSales").Copy
Sheets(DATABASE_SHEET).Range("I" & COUNT_ROw).PasteSpecial xlPasteValues
Range("TotalFuel").Copy
Sheets(DATABASE_SHEET).Range("J" & COUNT_ROw).PasteSpecial xlPasteValues
Range("TotalVol").Copy
Sheets(DATABASE_SHEET).Range("K" & COUNT_ROw).PasteSpecial xlPasteValues
Range("TaxableSales").Copy
Sheets(DATABASE_SHEET).Range("L" & COUNT_ROw).PasteSpecial xlPasteValues
Range("Non_Taxable").Copy
Sheets(DATABASE_SHEET).Range("M" & COUNT_ROw).PasteSpecial xlPasteValues
Range("Propane").Copy
Sheets(DATABASE_SHEET).Range("N" & COUNT_ROw).PasteSpecial xlPasteValues
Range("Collections").Copy
Sheets(DATABASE_SHEET).Range("O" & COUNT_ROw).PasteSpecial xlPasteValues
Range("E_CigsSales").Copy
Sheets(DATABASE_SHEET).Range("P" & COUNT_ROw).PasteSpecial xlPasteValues
Range("AccountFor").Copy
Sheets(DATABASE_SHEET).Range("Q" & COUNT_ROw).PasteSpecial xlPasteValues
Range("CreditCards").Copy
Sheets(DATABASE_SHEET).Range("R" & COUNT_ROw).PasteSpecial xlPasteValues
Range("StorePO").Copy
Sheets(DATABASE_SHEET).Range("S" & COUNT_ROw).PasteSpecial xlPasteValues
Range("CashDrop").Copy
Sheets(DATABASE_SHEET).Range("T" & COUNT_ROw).PasteSpecial xlPasteValues
Range("AccountedFor").Copy
Sheets(DATABASE_SHEET).Range("U" & COUNT_ROw).PasteSpecial xlPasteValues

Worksheets("Database").Protect
Application.ScreenUpdating = True

Call clearall
' Call Sort

End Sub

-------------------------------------------------------------------------------------------------

Sub clearall()

Range("Posted").Select
Selection.ClearContents
Worksheets("Main").Protect

End Sub
-----------------------------------------------------------------------------------------------------
? Ran Very Slow with this Sub
' Sub Sort()
' With Sheets("DATABASE").Sort
' .SortFields.Add Key:=Range("A2"), Order:=xlAscending
' .SortFields.Add Key:=Range("B1"), Order:=xlAscending
' .SetRange Range("A1:u1010")
' .Header = xlYes
' .Apply
' End With

' End Sub

[Greg M]

Hi there,

Instead of copying and pasting, you could insert something like the following (untested!) suggestion into the body of your routine and see if it makes a difference:

Please Login or Register  to view this content.

Hope this helps.

Regards,

Greg M

[teebee101]

Thank You I will try it

[teebee101]

its gives me Application-defined or object-defined error on the Attachment 805386


Sub over()


Dim wksMain As Worksheet

Set wksMain = Sheets("main")

With Sheets("DATABASE")

.Range("A" & COUNt_ROw).Value = wksMain.Range("Date").Value
.Range("B" & COUNt_ROw).Value = wksMain.Range("RegVol").Value
.Range("C" & COUNt_ROw).Value = wksMain.Range("SpecVol").Value
.Range("D" & COUNt_ROw).Value = wksMain.Range("SupVol").Value
.Range("E" & COUNt_ROw).Value = wksMain.Range("DVol").Value
.Range("F" & COUNt_ROw).Value = wksMain.Range("RegSales").Value
.Range("G" & COUNt_ROw).Value = wksMain.Range("SpecSales").Value
.Range("H" & COUNt_ROw).Value = wksMain.Range("SupSales").Value
.Range("I" & COUNt_ROw).Value = wksMain.Range("DSales").Value
.Range("J" & COUNt_ROw).Value = wksMain.Range("TotalFuel").Value
.Range("K" & COUNt_ROw).Value = wksMain.Range("TotalVol").Value
.Range("L" & COUNt_ROw).Value = wksMain.Range("TaxableSales").Value
.Range("M" & COUNt_ROw).Value = wksMain.Range("Non_Taxable").Value
.Range("N" & COUNt_ROw).Value = wksMain.Range("Propane").Value
.Range("O" & COUNt_ROw).Value = wksMain.Range("Collections").Value
.Range("P" & COUNt_ROw).Value = wksMain.Range("E_CigsSales").Value
.Range("Q" & COUNt_ROw).Value = wksMain.Range("AccountFor").Value
.Range("R" & COUNt_ROw).Value = wksMain.Range("CreditCards").Value
.Range("S" & COUNt_ROw).Value = wksMain.Range("StorePO").Value
.Range("T" & COUNt_ROw).Value = wksMain.Range("CashDrop").Value
.Range("U" & COUNt_ROw).Value = wksMain.Range("AccountedFor").Value

End With

Application.ScreenUpdating = True
Worksheets("Database").Protect

Call clearall
End Sub

[deadlyduck]

It looks like the Paste range is a series of adjacent columns. Is the Copy range also a series of adjacent columns? If so, you could do a single copy and single paste rather than multiple such actions.

[bebo021999]

Try to upload a sample workbook to see how the source ranges look like..

[teebee101]

Attached is the file

[Greg M]

Hi again,

Are you sure that your basic code is correct?

Please Login or Register  to view this content.

On the "Database" worksheet:

Column F refers to "SuperSales"
Column G refers to "PlusSales"
Column H refers to "RegSales"

You'll make life easier for yourself if you have full coordination between your header texts and your defined names - e.g. the named range "SpecVol" (Main!C6) corresponds to the "Plus Vol" column on the "Database" worksheet. When you're trying to cope with inconsistencies like these it can make life VERY difficult!


The approach I would take is to have a hidden row at the top of the "Main" worksheet which contains the appropriate values (linked by formulas) in the sequence required by the "Database" worksheet. These values can then easily be "stuffed" into a single-row array which is then "dumped" into the appropriate row on the "Database" worksheet. I can give you more information about this approach if you need.


Hope this helps.

Regards,

Greg M

[bsalv]

this is only one write instead of 21, but is less readable

Please Login or Register  to view this content.

[teebee101]

Thank You, so a hidden top row with just the values of main sheet in the same order as the database sheet?Attachment 805535

[Greg M]

Hi again,

Yes. The values in the hidden row can be easily assigned to an array, and the values in the array can be assigned to the appropriate row in the Database worksheet. The key is to ensure that the sequence of cells in the hidden row is the same as the sequence of columns on the Database worksheet.

Sorry, I wasn't able to open the attachment you posted, otherwise I'd have tried to include the code required.

Hope this helps.

Regards,

Greg M