Paste row from an array

Question

I've been trying for hours to paste a single row from a VBA array in an Excel sheet.

The code should be looking like this:

Dim wsSource As Worksheet
Set wsSource = Sheets("Data Retrieval - Source")
Dim wsDestination As Worksheet
Set wsDestination = Sheets("Data Retrieval - Destination")
Dim TableAbarSource
TableAbarSource = wsSource.Range("A3:U299729")

wsDestination.Range("A3:Z3") = ?

Any idea?

Thank you very much for your help!

Added the original code (which works fine) that I need to optimize below. As you can see, there is nearly 300,000 loops so declaring tables as variable would make some sense.

Sub DataRetrieval()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Variable definitions
    'Worksheets
Dim wsSource As Worksheet
Set wsSource = Sheets("Data Retrieval - Source")
Dim wsDestination As Worksheet
Set wsDestination = Sheets("Data Retrieval - Destination")
Dim wsDefaultList As Worksheet
Set wsDefaultList = Sheets("Default List")

    'Core ID
Dim CoreIDSource As Long 'Core ID number of the sheet Data Retrieval - Source
Dim CoreIDModel As Long 'Core ID number of the sheet Model
Dim ComparingCoreID As Variant

    'Count
Dim RowCountSource As Long 'Count the rows of the sheet Data Retrieval - Source
Dim RowCountDestination As Long 'Count the rows of the sheet Data Retrieval (destination)
RowCountDestination = 4

'Preparing sheet Data Retrieval (destination)
wsDestination.Range("A3:CC500000").Delete

With wsSource 'Copy header
    .Range(.Cells(3, 1), .Cells(3, 200)).Copy wsDestination.Cells(3, 1) 'Copy table header
End With

'Comparing Core ID of source sheet to Core ID of Model sheet
For RowCountSource = 4 To 300000

    CoreIDSource = wsSource.Cells(RowCountSource, 2)

    Set ComparingCoreID = wsDefaultList.Range("B4:B1507").Cells.Find(What:=CoreIDSource, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False) 'Definition of the Find variable 'Do not use variables for range to save time

    If Not ComparingCoreID Is Nothing Then
        With wsSource
        .Range(.Cells(RowCountSource, 1), .Cells(RowCountSource, 200)).Copy wsDestination.Cells(RowCountDestination, 1) 'Copier les données chiffrées
        End With
        RowCountDestination = RowCountDestination + 1
    End If

Next RowCountSource

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Is there a reason you want to use an array? why not simply wsdestination.Rows(3).value = wsSource.rows(3).value? — Scott Craner
– Scott Craner, Commented Nov 17, 2015 at 15:39
It's because the macro will compare 299,726 numbers to 1,700 numbers and copy paste the row in another sheet if the numbers match. I want to use arrays to speed up the process. The link to an interesting piece of code that I have not been able to use properly: stackoverflow.com/questions/25185230/… — Shimuno
– Shimuno, Commented Nov 17, 2015 at 15:43
For that you will need loops. Then instead of the 3 dictating the row you will use two variables. One that dictated the row to be copied based on the loops and a second dictating the row to paste based on finding the next open row. There are many many examples of how to do this. Google "Copy paste row based on certain value". You still do not need an array. A range is an array in itself. You will still need to loop through the array. — Scott Craner
– Scott Craner, Commented Nov 17, 2015 at 15:46
Or you could loop through your 1700 numbers and use a filter, and copy the visible cells, then paste them where you want them. — Scott Craner
– Scott Craner, Commented Nov 17, 2015 at 15:50

PaulG · Accepted Answer · 2015-11-17 15:56:16Z

0

There's probably 100 different ways to do this:

Sub test()

Dim rSource As Range
Dim rDest As Range

Set rSource = Sheet1.Range("A1:D100")
Set rDest = Sheet2.Range("A1")
Call rSource.Resize(1).Copy(rDest)

End Sub

Something like this may be good enough. Alter the line Call as required from:

rSource.Resize(1).Copy(rDest)

To something like:

Call rSource.Resize(1).offset(10).Copy(rDest)

answered Nov 17, 2015 at 15:56

PaulG

1,2078 silver badges9 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Shimuno Over a year ago

Apologies, but you'll have to walk me through here. How this code will speed up the loops?

PaulG Over a year ago

Yep, sorry my browser only showed the top part of the query. Not until I checked later... What I would consider is to cache the lookup ids in Scripting dictionaries. So basically you create an entry for each data set key with the row. The lookup would be the key and the row would be the item. Then you would iterate the loop and for each id in the dictionary find it in the other dictionary using the Exists function and retrieve the item for the match to determine the rows to copy. That way you are not going through the object model which would be slower than accessing a dictionary.

Shimuno · Accepted Answer · 2015-11-19 09:40:44Z

I have found a solution. Using a loop to paste row data into an array is actually pretty fast. The whole macro takes about 5mn to run, compared to more than 30mn for the original code.

The trick here was to break the 300,000 rows into smaller blocks of 25,000 rows to avoid the "out of memory" error.

Here is the code, maybe it will help somebody.

Sub DataRetrieval()
'This macro retrieves the Database data of defaulted companies.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'VARIABLE DECLARATION
'Worksheets
Dim wsSource As Worksheet
Set wsSource = Sheets("Data Retrieval - Source")
Dim wsDestination As Worksheet
Set wsDestination = Sheets("Data Retrieval - Destination")
Dim wsDefaultList As Worksheet
Set wsDefaultList = Sheets("Default List")

'Core ID
Dim CoreIDSource As Long 'Core ID number of the sheet Data Retrieval - Source
Dim CoreIDModel As Long 'Core ID number of the sheet Model
Dim ComparingCoreID As Variant

'Count
Dim RowCountSource As Long 'Count the rows of the sheet Data Retrieval - Source
Dim RowCountDestination As Long 'Count the rows of the sheet Data Retrieval (destination)
RowCountDestination = 0
Dim ColumnCountDestination As Byte

'Tables
Dim TableSource() 'Dynamic table that will store data retrieved from Database
Erase TableSource 'Empty memory to avoid execution issues in case the program breaks before completion
'(tables also erased at the end)
Dim TableDestination(50000, 49) 'Table that will store the data from TableSource. Can store up to 50 columns
Erase TableDestination
Dim TableCoreID() 'Table that will store the list of revised CoreID
TableCoreID = wsDefaultList.Range("B5:B2000") 'First number is 1, not zero. The table is defined like that to avoid
'issues if one of the Core ID is blank (in that case, a table defined dynamically would stop at the blank cell)

'FORMATTING DESTINATION SHEET
'Preparing sheet Data Retrieval (destination)
wsDestination.Range("A3:CC500000").ClearContents

'Copy header
wsSource.Rows(3).Copy
wsDestination.Rows(3).PasteSpecial xlPasteValues

'Format header
With wsDestination.Rows(3)
    .NumberFormat = "@"
    .VerticalAlignment = xlCenter
    .HorizontalAlignment = xlRight
    With .Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 8
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
    End With
    With .Interior
        .ThemeColor = xlThemeColorAccent1
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
End With

'STORING DATA IN TABLEDESTINATION VARIABLE
'25,000 rows
TableSource = wsSource.Range("A4:AX25003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'50,000 rows
TableSource = wsSource.Range("A25004:AX50003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'75,000 rows
TableSource = wsSource.Range("A50004:AX75003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'100,000 rows
TableSource = wsSource.Range("A75004:AX100003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'125,000 rows
TableSource = wsSource.Range("A100004:AX125003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'150,000 rows
TableSource = wsSource.Range("A125004:AX150003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'175,000 rows
TableSource = wsSource.Range("A150004:AX175003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'200,000 rows
TableSource = wsSource.Range("A175004:AX200003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'225,000 rows
TableSource = wsSource.Range("A200004:AX225003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'250,000 rows
TableSource = wsSource.Range("A225004:AX250003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'275,000 rows
TableSource = wsSource.Range("A250004:AX275003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'300,000 rows
TableSource = wsSource.Range("A275004:AX300003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'325,000 rows
TableSource = wsSource.Range("A300004:AX325003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'350,000 rows
TableSource = wsSource.Range("A325004:AX350003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'375,000 rows
TableSource = wsSource.Range("A350004:AX375003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'400,000 rows
TableSource = wsSource.Range("A375004:AX400003") 'First row and column numbers are 1 and not 0
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination)

'PASTING DATA IN SHEET DESTINATION AND FORMATTING
'Paste TableSource
wsDestination.Range("A4:AX50004") = TableDestination

'Format pasted area
wsDestination.Select 'The sheet must be activated
wsDestination.Range("A4:AX50004").Select
Call TableRows

wsDestination.Cells.HorizontalAlignment = xlLeft

'Empty memory
Erase TableSource
Erase TableDestination
Erase TableCoreID

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Sub LoopRetrieveDefaultData(RowCountSource As Long, TableSource As Variant, TableCoreID As Variant, ColumnCountDestination As Byte, TableDestination As Variant, RowCountDestination As Long)

For RowCountSource = 1 To 25000
    If IsError(Application.Match(TableSource(RowCountSource, 2), TableCoreID, 0)) = False Then 'Comparing Core ID. The
    'column number is 2 and not 1 because the first column of the table is 1
    'from TableSource (Arrow Bar data) to list of defaults Core ID(TableCoreID)
    For ColumnCountDestination = 0 To 49 'Paste correponding row in TableDestination
        TableDestination(RowCountDestination, ColumnCountDestination) = TableSource(RowCountSource, ColumnCountDestination + 1)
    Next ColumnCountDestination
    RowCountDestination = RowCountDestination + 1
    End If
Next RowCountSource
End Sub

Collectives™ on Stack Overflow

Paste row from an array

2 Answers 2

2 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related