Efficient ways to copy and paste data

[rTm335]

Have a few questions about the most efficient way to copy data from one worksheet to another.
Have looked at a few texts, references online, including this forum. Below is what I have so far. It works, but I suspect it is awkward.
Looking for comments and suggestions. Thanks.

Q1: Is there a more efficient way to select a range?
Q1.1 example #1 could the following be condensed to 2 lines rather than 3?
Dim gNames As Range
Range("B3").Select
Set gNames = Range(Selection, Selection.End(xlToRight))

Q1.2: could the following be condensed to a single line?
Range("A3").Offset(1, k - 1).Select
Range(Selection, Selection.End(xlDown)).Select



Q2: is there a more efficient way to select, copy, and paste?
e.g. (note that c and k are defined in the full code below. c is a Cell and k is an integer).

Range("A3").Offset(1, k - 1).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Worksheets("Sheet1").Cells(c.Row + 1, c.Column).Select
ActiveSheet.Paste

Q3: Any recommendations about the following code?
This is just a test program. Eventually this will be scaled up to handle about 200 keys, and about 5000 data values for each key.
keys and data will be on different worksheets. The data copied below the keys will be used to generate some Excel graphs.

Sub CopyStoS()
'
' Objective: copy data from one region to another, based on the value of a key.
' Details:
' gNames: List of keys starting on B3 (length of list is variable, e.g. B3 to D3 or B3 to F3)
' Actions:
' 1. for each key in gNames, check if the key is found in the range I3:L3
' 2. if key is found in range I3:L3, copy the data in that column (e.g. I4:I44, the length of data is variable) to below the B3 key.
'
Dim k As Integer
Dim gNames As Range
Range("B3").Select
Set gNames = Range(Selection, Selection.End(xlToRight))
For Each c In gNames
k = Find_Index(Trim(c.Value))
If (k > -1) Then
MsgBox ("found it" & CStr(k))
Range("A3").Offset(1, k - 1).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Worksheets("Sheet1").Cells(c.Row + 1, c.Column).Select
ActiveSheet.Paste
End If
Next
End Sub
Function Find_Index(findString As String) As Integer
Dim rng As Range
Dim i As Integer
Dim found As Boolean
If Trim(findString) <> "" Then
With Sheets("Sheet1").Range("I3:L3") 'searches specified Range in Sheet 1
Set rng = .Find(What:=findString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
found = True
i = rng.Column
Else
found = False
i = -1
End If
End With
End If
Find_Index = i
End Function

 

[GWteB]

'Most efficient' will be almost impossible and sometimes not worth the effort. Making your code more readable however, is where efficiency might start ...
If I'm right, you are searching for a way to omit the Select statement. Setting up the right object references makes that possible. I have modified your code to illustrate what I mean. Notice the use of the Range references; be sure to clean them before the routine ends. Using the Select statement in debug mode might be helpfull to see what´s going on. Hope this is of some help.

[COLOR=darkblue]Sub[/COLOR] CopyStoS()
    
    [COLOR=darkblue]Dim[/COLOR] wsMysheet       [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] gNames          [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] raTemp          [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] raFindResult    [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] raSearchIn      [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] raTarget        [COLOR=darkblue]As[/COLOR] Range
                                
    [COLOR=green]' setup some specific Range objects[/COLOR]
    [COLOR=darkblue]Set[/COLOR] wsMysheet = ThisWorkbook.Sheets("Sheet1")
    [COLOR=darkblue]Set[/COLOR] raSearchIn = wsMysheet.Range("I3:L3")
    
    [COLOR=darkblue]Set[/COLOR] raTemp = wsMysheet.Range("B3")
    [COLOR=darkblue]Set[/COLOR] gNames = Range(raTemp, raTemp.End(xlToRight))
    

    [COLOR=green]' not really necessary; might increase performance when running multiple times[/COLOR]
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    Application.Calculation = xlCalculationManual
    
    
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] c [COLOR=darkblue]In[/COLOR] gNames
        
        [COLOR=darkblue]With[/COLOR] raSearchIn
            [COLOR=darkblue]Set[/COLOR] raFindResult = .Find(What:=Trim(c.Value), _
                                     After:=.Cells(.Cells.Count), _
                                     LookIn:=xlValues, _
                                     LookAt:=xlWhole, _
                                     SearchOrder:=xlByRows, _
                                     SearchDirection:=xlNext, _
                                     MatchCase:=False)
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        
        [COLOR=darkblue]If[/COLOR] raFindResult [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
            [COLOR=green]' do nothing[/COLOR]
            
        [COLOR=darkblue]Else[/COLOR]
            MsgBox "found it" & raFindResult.Column
            
            [COLOR=darkblue]With[/COLOR] wsMysheet
                [COLOR=darkblue]Set[/COLOR] raTemp = .Range("A3").Offset(1, raFindResult.Column - 1)
                [COLOR=darkblue]Set[/COLOR] raTarget = .Cells(c.Row + 1, c.Column)
    
                Range(raTemp, raTemp.End(xlDown)).Copy
                .Paste Destination:=raTarget
                Application.CutCopyMode = [COLOR=darkblue]False[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
    [COLOR=darkblue]Next[/COLOR]
    
    
    [COLOR=green]' restoring ...[/COLOR]
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    Application.Calculation = xlCalculationAutomatic
    
    
    [COLOR=darkblue]Set[/COLOR] wsMysheet = [COLOR=darkblue]Nothing[/COLOR]
    [COLOR=darkblue]Set[/COLOR] gNames = [COLOR=darkblue]Nothing[/COLOR]
    [COLOR=darkblue]Set[/COLOR] raTemp = [COLOR=darkblue]Nothing[/COLOR]
    [COLOR=darkblue]Set[/COLOR] raFindResult = [COLOR=darkblue]Nothing[/COLOR]
    [COLOR=darkblue]Set[/COLOR] raSearchIn = [COLOR=darkblue]Nothing[/COLOR]
    [COLOR=darkblue]Set[/COLOR] raTarget = [COLOR=darkblue]Nothing[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[rTm335]

Thanks. Yes, avoiding the select statement was the first thing that I was looking for. Also, examples of how to organize this, e.g. the use of With in your example.
I will apply this example and report back.
Eventually the data will be copied from one worksheet and pasted to another worksheet (both in the same notebook). Am hoping that this is a small step from the example above.

P.S. The code was indented when I posted it, but I am seeing that the indenting and blank lines were lost after posting. Will re-read the help documents on the forum to figure out how to avoid that in the future.

 

[rTm335]

Would appreciate comments about how to improve the following code, adapted from the recommendations provided above.
Note that when copying data from one worksheet to another, it takes about 10 to 20 seconds, which is acceptable.
However, each entry in the copied range must be converted from one set of units to another (e.g. degrees F to degrees C), by applying (v + b)*m to each entry, v. When I added that, the code slowed down and now takes about 6.5 minutes to copy the data and convert the units.
The code that is slow is the following.

                'convert units for values
                m = wsGraphdata.Cells(c.Row + mOffset, c.Column)
                b = wsGraphdata.Cells(c.Row + bOffset, c.Column)
                
                Set raTemp2 = wsGraphdata.Cells(c.Row + vOffset, c.Column)
                Set gValues = Range(raTemp2, raTemp2.End(xlDown))
                For Each v In gValues
                    v.Value = (v.Value + b) * m
                Next

Below is the entire procedure. Kindly let me know where and how to improve this code. Thanks!

Sub CopyHistorianData()
   
    Dim iHistdata       As Integer      'index of chosen historian data
    Dim wsGraphdata     As Worksheet    'worksheet with data for graphing
    Dim wsHistdata      As Worksheet    'worksheet with chosen historian data
    Dim wsDataControl   As Worksheet    'worksheet where user choses data source
    Dim gNames          As Range
    Dim raTemp          As Range
    Dim raTemp2         As Range
    Dim raFindResult    As Range
    Dim raSearchIn      As Range
    Dim raTarget        As Range
    Dim gValues         As Range
    
    Dim m               As Double
    Dim b               As Double
    
    Dim vOffset         As Integer
    Dim mOffset         As Integer
    Dim bOffset         As Integer
    '
    Dim nOffset         As Integer
    Dim nMax            As Integer
    '
    Dim iCount          As Integer
    
    
    'graph data locations
    vOffset = 7     'offset from key for the value
    mOffset = 5     'offset from key to the multiplier for unit conversions
    bOffset = 4     'offset from ket to the constant for unit conversions
    
    'historian file
    nOffset = 5
    nMax = 12
                                
    ' setup some specific Range objects
    Set wsDataControl = ThisWorkbook.Sheets("Data Control")
    iHistdata = nOffset + wsDataControl.Range("B11").Value
    If (iHistdata < (nOffset + 0) Or iHistdata > (nOffset + nMax)) Then
       MsgBox (" 0 < i < 12 in cell B11; Out of range value:" & CStr(iHistdata))
    End If
    
    ' historian list of available data
    Set wsHistdata = ThisWorkbook.Sheets(iHistdata)
    Set raSearchIn = wsHistdata.Range("A1:ACI1")
    
    ' graphing data: list of data to graph
    Set wsGraphdata = ThisWorkbook.Sheets("dataT1")
    Set raTemp = wsGraphdata.Range("C4")
    Set gNames = Range(raTemp, raTemp.End(xlToRight))


    ' might increase performance when running multiple times
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    iCount = 0
    wsGraphdata.Activate
    For Each c In gNames
        iCount = iCount + 1
        Set raTemp = wsGraphdata.Range("A1").Offset(c.Row + vOffset - 1, c.Column - 1)
        Range(raTemp, raTemp.End(xlDown)).Clear 'remove existing data
        
        'MsgBox "look for: " & Trim(c.Value)
        With raSearchIn
            Set raFindResult = .Find(What:=Trim(c.Value), _
                                     After:=.Cells(.Cells.Count), _
                                     LookIn:=xlValues, _
                                     LookAt:=xlWhole, _
                                     SearchOrder:=xlByRows, _
                                     SearchDirection:=xlNext, _
                                     MatchCase:=False)
        End With
        
        If raFindResult Is Nothing Then
            ' do nothing
            
        Else
            'MsgBox "found it" & raFindResult.Column
            
            With wsGraphdata
                'copy data from the historian
                Set raTemp = wsHistdata.Range("A1").Offset(2, raFindResult.Column - 1)
                Set raTarget = wsGraphdata.Cells(c.Row + vOffset, c.Column)
    
                Range(raTemp, raTemp.End(xlDown)).Copy


                'paste data to the graphing data
                wsGraphdata.Paste Destination:=raTarget
                Application.CutCopyMode = False
                
                'convert units (e.g. degrees C to F) from historian to plotting units
                m = wsGraphdata.Cells(c.Row + mOffset, c.Column)
                b = wsGraphdata.Cells(c.Row + bOffset, c.Column)
                
                Set raTemp2 = wsGraphdata.Cells(c.Row + vOffset, c.Column)
                Set gValues = Range(raTemp2, raTemp2.End(xlDown))
                For Each v In gValues
                    v.Value = (v.Value + b) * m
                Next
            End With
        End If
    
        If (iCount > 500) Then GoTo EarlyExit
    Next
    
EarlyExit:


    wsDataControl.Activate
    
    ' restoring ...
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationManual 'xlCalculationAutomatic
    
    




    Set wsGraphdata = Nothing
    Set wsHistdata = Nothing
    Set wsDataControl = Nothing
    Set gNames = Nothing
    Set raTemp = Nothing
    Set raTemp2 = Nothing
    Set raFindResult = Nothing
    Set raSearchIn = Nothing
    Set raTarget = Nothing
    Set gValues = Nothing
    
End Sub

 

[GWteB]

You are processing a lot of data, obviously. As you already have discovered, the conversion (=calculation) is the most time consuming job (a loop in the inner of a loop). I have no idea how you could address this. In general (just a bunch of thoughts):

• prevent the launch of unwanted code, triggered by events;
• in your code the Offset property appears quite a bit. Maybe you can find a way to reduce that, for example to create more consistency between source and target worksheets;
• perhaps it's possible to avoid the Copy instruction in the loop; you could make a copy of the entire source sheet, perform a search to determine which columns you would convert; by saving the column numbers (in an array for example) you could delete the unwanted columns afterwards;
• as far as I know, conversion of degrees could be performed by the use of constants; you better declare them in your code, rather pulling them from a worksheet in a loop;
• the Copy method could be used in one line (source.Copy Destination:=target) so the Paste and the CutCopyMode instructions are superfluous.

Hope that helps,
Regards.

 

[rTm335]

Confirmed that the code runs in less than 15 seconds, which is acceptable, with only the assignment in the inner loop commented out,see below.

Note: this runs in 15 seconds or less:

                Set raTemp2 = wsGraphdata.Cells(c.Row + vOffset, c.Column)
                Set gValues = Range(raTemp2, raTemp2.End(xlDown))
                For Each v In gValues
                '    v.Value = (v.Value + b) * m
                Next

This runs in 6 minutes or more.

                Set raTemp2 = wsGraphdata.Cells(c.Row + vOffset, c.Column)
                Set gValues = Range(raTemp2, raTemp2.End(xlDown))
                For Each v In gValues
                    v.Value = (v.Value + b) * m
                Next

I wonder ... after a column of the historian data has been copied, (i.e. after Range(raTemp, raTemp.End(xlDown)).Copy) is it is possible to do the following:
a) assign the values in the copied range to an array (should be variable length, or an arbitrarily large length),
b) loop through the entries in the array to change the units,
c) paste the array into the desired location?
(this may a variation of GWteB recommendations).

Any comments on this idea?

Note that I would like to do this copy/modify/paste operation on a column by column basis, because the unit conversions can change from column to column and the units may change.

Could provide some sample code (or a link) for placing a copied range into an array, looping through an array, and then pasting the results? Meanwhile, I will look for examples in what has already been posted.

 

[rTm335]

Below is the revise code using an array. It runs the test cases in less than 15 seconds.
Please let me know any recommendations for improving the code. Thanks!

Sub CopyHistorianData()
   
    Dim iHistdata       As Integer      'index of chosen historian data
    Dim wsGraphdata     As Worksheet    'worksheet with data for graphing
    Dim wsHistdata      As Worksheet    'worksheet with chosen historian data
    Dim wsDataControl   As Worksheet    'worksheet where user choses data source
    Dim gNames          As Range
    Dim raTemp          As Range
    Dim raFindResult    As Range
    Dim raSearchIn      As Range
    Dim raTarget        As Range
    Dim gValues         As Range
    
    Dim aValues         As Variant
    Dim iCountaValues   As Integer
    Dim iNdex           As Integer
    Dim iRowStart       As Integer
    Dim iRowStop        As Integer
    
    Dim m               As Double
    Dim b               As Double
    
    Dim vOffset         As Integer
    Dim mOffset         As Integer
    Dim bOffset         As Integer
    '
    Dim nOffset         As Integer
    Dim nMax            As Integer
    '
    Dim iCount          As Integer
    
    
    'graph data locations
    vOffset = 7     'offset from key for the value
    bOffset = 4     'offset from ket to the constant for unit conversions
    mOffset = 5     'offset from key to the multiplier for unit conversions
    
    'historian file
    nOffset = 5
    nMax = 12
                                
    ' setup some specific Range objects
    Set wsDataControl = ThisWorkbook.Sheets("Data Control")
    iHistdata = nOffset + wsDataControl.Range("B11").Value
    If (iHistdata < (nOffset + 0) Or iHistdata > (nOffset + nMax)) Then
       MsgBox (" 0 < i < 12 in cell B11; Out of range value:" & CStr(iHistdata))
    End If
    
    ' historian list of available data
    Set wsHistdata = ThisWorkbook.Sheets(iHistdata)
    Set raSearchIn = wsHistdata.Range("A1:ACI1")
    
    ' graphing data: list of data to graph
    Set wsGraphdata = ThisWorkbook.Sheets("dataT1")
    Set raTemp = wsGraphdata.Range("C4")
    Set gNames = Range(raTemp, raTemp.End(xlToRight))


    ' might increase performance when running multiple times
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    iCount = 0
    wsGraphdata.Activate
    For Each c In gNames
        iCount = iCount + 1
        Set raTemp = wsGraphdata.Range("A1").Offset(c.Row + vOffset - 1, c.Column - 1)
        Range(raTemp, raTemp.End(xlDown)).Clear 'remove existing data
        
        'MsgBox "look for: " & Trim(c.Value)
        With raSearchIn
            Set raFindResult = .Find(What:=Trim(c.Value), _
                                     After:=.Cells(.Cells.Count), _
                                     LookIn:=xlValues, _
                                     LookAt:=xlWhole, _
                                     SearchOrder:=xlByRows, _
                                     SearchDirection:=xlNext, _
                                     MatchCase:=False)
        End With
        
        If raFindResult Is Nothing Then
            ' do nothing
            
        Else
            'MsgBox "found it" & raFindResult.Column
            
            With wsGraphdata
                'copy data from the historian
                Set raTemp = wsHistdata.Range("A1").Offset(2, raFindResult.Column - 1)
                aValues = Range(raTemp, raTemp.End(xlDown))
                iCountaValues = UBound(aValues, 1)
                
                'convert units for values
                m = wsGraphdata.Cells(c.Row + mOffset, c.Column)
                b = wsGraphdata.Cells(c.Row + bOffset, c.Column)
                For iNdex = 1 To iCountaValues
                    aValues(iNdex, 1) = (aValues(iNdex, 1) + b) * m
                Next
                
                'assign historian data to target
                iRowStart = c.Row + vOffset
                iRowStop = iRowStart + iCountaValues - 1
                Set raTarget = wsGraphdata.Range(Cells(iRowStart, c.Column), Cells(iRowStop, c.Column))
        
                raTarget.Value = aValues


            End With
        End If
    
        If (iCount > 500) Then GoTo EarlyExit
    Next
    
EarlyExit:


    wsDataControl.Activate
    
    ' restoring ...
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationManual 'xlCalculationAutomatic
    
    
    Set wsGraphdata = Nothing
    Set wsHistdata = Nothing
    Set wsDataControl = Nothing
    Set gNames = Nothing
    Set raTemp = Nothing
    Set raFindResult = Nothing
    Set raSearchIn = Nothing
    Set raTarget = Nothing
    Set gValues = Nothing
    
End Sub