CODEWITHSUNDEEP
vbaexcel
Dane O'Connor
Dane O'Connor

Reputation: 77378

How do I copy a range into a temp workbook and return a reference to it with a vba function?

I have the following which errors on the "rTemp.Value = vaTemp" line. What am I doing wrong here? Am I on the right track?

Function CreateTempRange(rSource As range) As range
    ' Declarations
    Dim rTemp As range
    Dim vaTemp As Variant
    Dim wsTemp As Worksheet
    Dim wbTemp As Workbook

    ' Open temp worksheet
    Set wbTemp = Workbooks.Add
    Set wsTemp = wbTemp.Worksheets.Add

    ' Copy range into it and get a reference to the temp range
    vaTemp = rSource.Value
    Set rTemp = wsTemp.range("A1").Resize(UBound(vaTemp, 1), UBound(vaTemp, 2))
    rTemp.Value = vaTemp

    ' Return the temp range
    Set CreateTempRange = rTemp
End Function

Note: This function is intended to be used by other functions and not called directly from a cell.

Upvotes: 2

Views: 3698

Answers (4)

Adam Ralph
Adam Ralph

Reputation: 29955

I would do it like this

Function CreateTempRange(src As Range) As Range

Dim wbk As Workbook: Set wbk = Workbooks.Add
Dim sht As Worksheet: Set sht = wbk.Worksheets.Add

Call src.Copy(sht.Cells(1, 1))

Set CreateTempRange = Range(rSource.Address).Offset(1 - rSource.Row, 1 - rSource.Column)

End Function

Explanation of the last line of code (as requested):-

Range(rSource.Address) - this refers to the range on the current worksheet (containing the code) with the same local address as the source range, so if the the source range is C3:E5 on 'Sheet X' then Range(rSource.Address) refers to C3:E5 on the current sheet.

Since we pasted the copied range into the current sheet starting at cell A1 rather than cell C3 (I assume this is your requirement), we then need to offset this reference accordingly. The .Offset(1 - rSource.Row, 1 - rSource.Column) offsets this range negatively by both the row index (3) minus 1 and column index (C or 3) minus 1 of the source range, so that the final resulting reference starts with cell A1 and keeps the same dimensions as the source range.

Hope that helps.

Upvotes: 1

Dick Kusleika
Dick Kusleika

Reputation: 33175

Deano, that code works for me as written. What is the error you're getting?

Upvotes: 0

barrowc
barrowc

Reputation: 10689

vaTemp = rSource.Value

As you aren't specifying the RangeValueDataType parameter to the Value method of the Range object, it will default to xlRangeValueDefault which, for non-empty ranges, will return an array of values. Therefore, the UBound(..., 1) and UBound(..., 2) parts make sense.

This would be easier:

Function CreateTempRange(rSource As range) As range
    ' Declarations
    Dim rTemp As range
    Dim wsTemp As Worksheet
    Dim wbTemp As Workbook

    ' Open temp worksheet
    Set wbTemp = Workbooks.Add
    Set wsTemp = wbTemp.Worksheets.Add

    ' Create new range on that sheet starting at cell A1
    Set rTemp = wsTemp.Range(Cells(1, 1), Cells(rSource.Rows.Count, _
        rSource.Columns.Count))
    rTemp.Value = rSource.Value

    ' Return the temp range
    Set CreateTempRange = rTemp
End Function

You would still need some code to deal with ranges which consist of multiple areas (use the Areas.Count property to check for that)

Upvotes: 1

Mark Nold
Mark Nold

Reputation: 5698

Set rTemp = wsTemp.range("A1").Resize(UBound(vaTemp, 1), UBound(vaTemp, 2)

There'll be a type mismatch here ... i'm not sure it really makes any sense. ubound(a,2) is used for multi-dimensional arrays not ranges.

I'm guessing you want to take the value in the cell specified then copy it many times depending on it's value. Is that correct?

Hopefully the below should give you an example to work with. If not edit your post and i'll see if i can help. 

Function CreateTempRange(rSource As Range) As Range
    '' Declarations
    Dim rTemp As Range
    Dim vaTemp As Variant

    Dim wsTemp As Worksheet
    Dim wbTemp As Workbook

    '' Open temp worksheet
    Set wbTemp = Workbooks.Add
    Set wsTemp = wbTemp.Worksheets.Add

    '' Copy range into it and get a reference to the temp range
    vaTemp = rSource.Value
    ''Set rTemp = wsTemp.Range("A1").Resize(UBound(vaTemp, 1), UBound(vaTemp, 2))

    Dim iTemp As Integer
    On Error Resume Next
    iTemp = CInt(vaTemp)
    On Error GoTo 0

    If iTemp < 1 Then
      iTemp = 1
    End If
    Set rTemp = wsTemp.Range("A1:A" & iTemp)
    rTemp.Value = vaTemp

    '' Return the temp range
    Set CreateTempRange = rTemp
End Function

Sub test()

  Dim r As Range
  Dim x As Range
  Set r = ActiveSheet.Range("A1")
  Set x = CreateTempRange(r)

End Sub

Upvotes: 1

Related Questions