Data Dump using VBA

[Rudi]

Hi,

I have someone that copies in excess of 50000 rows of data from one workbook to another workbook (which then processes the pasted data with many formulas).
The copy/paste (and subsequent formula processing) takes several minutes in Excel.

I have come up with the following macro that transfers the data in a fraction of the time, but the ONLY issue is that it seems to paste with an offset; in the sample file the offset is 2 rows down, 2 columns to the right??? How does this offset occur and how can it be fixed so that it always pastes into the top left cell at the destination. Unfortunately, working with an array means that I have to calculate the destination range to be exactly the same amount of columns and rows as the source. Maybe there is a better way to do this over the method I am using in the macro.

TIA for any solutions.

Workbook and code attached...

DataDump.xlsm

[Rudi]

OK....
I noticed I was unintentionally creating a range offset by using: rDest.Range(sS,sE). Unfortunaltely I cannot use rDest.Range("A1",sE) as then the array block size is different. I need to somehow calculate the same size as the source, but be able to specify the same size in the destination at a relative location.

TX...

[Rudi]

Ah, I think I resolved it...
Should I dim the counts as Double???

Code: Select all

Sub OptimiseVBA()
    'Get current state of various Excel settings
    Dim screenUpdateState As Boolean, calcState As String, eventsState As Boolean, statusBarState As Boolean, displayPageBreakState As Boolean
    screenUpdateState = Application.ScreenUpdating
    calcState = Application.Calculation
    eventsState = Application.EnableEvents
    statusBarState = Application.DisplayStatusBar
    displayPageBreakState = ActiveSheet.DisplayPageBreaks    'Sheet-level setting

    Dim DataRange As Variant
    Dim rSource As Range, rDest As Range, dS As Double, dE As Double
    Set rSource = Application.InputBox("Select the entire range to copy.", Type:=8)
    Set rDest = Application.InputBox("Select first cell in range to paste.", Type:=8)
    
    'Turn off some Excel functionality to run code faster
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.DisplayStatusBar = False
    ActiveSheet.DisplayPageBreaks = False    'Sheet-level setting

    DataRange = rSource    'read all the values at once from the Excel grid, put into an array
    dS = rSource.Columns.Count '.Address
    dE = rSource.Rows.Count '.Address
    rDest.Range("A1", Cells(dE, dS).Address).Value = DataRange 'writes all the results back to the range at once

    'After your code runs, restore state
    ActiveSheet.DisplayPageBreaks = displayPageBreakState    'Sheet-level setting
    Application.DisplayStatusBar = statusBarState
    Application.EnableEvents = eventsState
    Application.Calculation = calcState
    Application.ScreenUpdating = screenUpdateState
End Sub

[HansV]

You don't need sS and sE. You can use the following to paste the values:

Code: Select all

    rDest.Resize(RowSize:=rSource.Rows.Count, _
        ColumnSize:=rSource.Columns.Count).Value = DataRange   'writes all the results back to the range at once

[Rudi]

TX...That works great!