2
\$\begingroup\$

I had some great feedback on my code previously here and I was hoping that I could get some further help with writing a column of the array to the worksheet.

I have an example here where I write one column of my array to the worksheet with a loop, but I'm wondering if there wouldn't be a more efficient way to do this:

Option Explicit
Option Base 1

Public Sub arrayMatch()

    Dim firstArray As Variant
    With ThisWorkbook.Worksheets(1)
        firstArray = .Range("A1", .Range("A1").End(xlDown).End(xlToRight))
    End With
    ReDim Preserve firstArray(UBound(firstArray, 1), UBound(firstArray, 2) + 1)

    Dim secondArray As Variant
    With ThisWorkbook.Worksheets(2)
        secondArray = .Range("A1", .Range("A1").End(xlDown).End(xlToRight))
    End With

    Dim rowFirstArray As Long
    Dim rowSecondArray As Long
    For rowFirstArray = 1 To UBound(firstArray,1)   
        For rowSecondArray = 1 To UBound(secondArray,1)        
            If firstArray(rowFirstArray, 3) = secondArray(rowSecondArray, 1) Then            
                firstArray(rowFirstArray, 4) = secondArray(rowSecondArray, 2)            
                Exit For     
            End If    
        Next rowSecondArray
    Next rowFirstArray
    Erase secondArray

    For rowFirstArray = 1 To UBound(firstArray, 1)
        ThisWorkbook.Worksheets(1).Cells(rowFirstArray, 4).Value = firstArray(rowFirstArray, 4)
    Next rowFirstArray
    Erase firstArray

End Sub
\$\endgroup\$
3
\$\begingroup\$

I wouldn't use

Option Base 1

It's completely unneeded, just change your loops to go from LBound to UBound. Remember, it's always better to stick with defaults otherwise you need to explain why you're doing it. Much easier -

For rowFirstArray = LBound(firstArray, 1) To UBound(firstArray, 1)

What's this for:

Dim previousSetting As Boolean
previousSetting = Application.DisplayAlerts
Application.DisplayAlerts = False
tempWS.Delete
Application.DisplayAlerts = previousSetting

You're turning it off no matter what anyway, there's no reason to store the setting. Why not just put it into an If block instead?

If Application.DisplayAlerts Then
    Application.DisplayAlerts = False
    tempWS.Delete
    Application.DisplayAlerts = True
    Else: tempWS.Delete
End If

I'm not sure what this is doing -

ReDim Preserve firstArray(UBound(firstArray, 1), UBound(firstArray, 2) + 1)

Usually you need to say 1 to UBound(...) for a dimension. But, you can't redimension the first dimension in a non- one dimensional array. So I'm not sure what is supposed to happen here.


Don't often see the Erase method

Erase secondArray

More commonly you set the array to nothing if you need to clean it up, but usually you won't need to clean it up.


Your With blocks aren't really needed

With ThisWorkbook.Worksheets(1)
    firstArray = .Range("A1", .Range("A1").End(xlDown).End(xlToRight))
End With

Can just be

firstArray = Sheet1.Range("A1", Sheet1.Range("A1").End(xlDown).End(xlToRight))

But I think what you mean is

firstArray = Sheet1.Range(Sheet1.Cells(1,1),Sheet1.Cells(lastRow, lastColumn))

What it's currently doing is

Range("A1") to (Rows.Count, 1)

The .End(xlToRight) isn't doing anything excepting the width of column A.


Dim rowFirstArray As Long
Dim rowSecondArray As Long
For rowFirstArray = 1 To UBound(firstArray,1)   
    For rowSecondArray = 1 To UBound(secondArray,1)        
        If firstArray(rowFirstArray, 3) = secondArray(rowSecondArray, 1) Then            
            firstArray(rowFirstArray, 4) = secondArray(rowSecondArray, 2) 

Is only needed if your two arrays are different sizes. Are they different sizes?

\$\endgroup\$
  • \$\begingroup\$ Thanks for the catch on conditionally disabling alerts :) \$\endgroup\$ – PeterT Sep 20 '16 at 20:21
  • \$\begingroup\$ After testing out the firstArray = .Range("A1", .Range("A1").End(xlDown).End(xlToRight)) I found this to be more reliable firstArray = .Range("A1", .Range("A1").CurrentRegion The ReDim is adding a column on the end that I can populate with the for loops results, I'm not sure how I can ReDim an array without referencing the original dimensions? I may not have needed Erase at all. Also I used the With blocks to explicitly reference ThisWorkbook as was advised in the previous linked post. Finally the arrays are indeed different sizes with different layouts. \$\endgroup\$ – Iain Saunders Sep 20 '16 at 20:40
  • 1
    \$\begingroup\$ An array can't be set to Nothing - Erase is specifically for clearing arrays. Agreed though, it's quite seldom needed. \$\endgroup\$ – Mathieu Guindon Sep 29 '16 at 1:59
  • \$\begingroup\$ @Mat'sMug thanks, I guess I've never cleaned up an array. I'll adjust my answer for accuracy. \$\endgroup\$ – Raystafarian Sep 29 '16 at 21:20
1
\$\begingroup\$

Here's an idea I had to make it easier:

Instead of looping through the whole array, use a temporary Worksheet to copy the entire array, then copy/paste only the column you need. It's pretty quick and painless.

Option Explicit

Sub test()
    Dim src As Variant
    src = ThisWorkbook.Sheets("Sheet1").UsedRange

    Dim dst As Range
    Set dst = ThisWorkbook.Sheets("Sheet1").Range("U1")
    ArrayColumnToSheetColumn src, 2, dst
End Sub

Sub ArrayColumnToSheetColumn(ByRef srcArray As Variant, _
                             ByVal colNum As Integer, _
                             ByRef destCell As Range)
    '--- copies the indicated column from the given array
    '    to the column starting at the destination cell
    If colNum > UBound(srcArray, 2) Then
        Debug.Print "ERROR: requested column " & colNum & _
                    " for copy, but the srcArray only has " & _
                    UBound(srcArray, 2) & " columns."
        Exit Sub
    End If

    Dim thisWB As Workbook
    Dim tempWS As Worksheet
    Set thisWB = ThisWorkbook
    Set tempWS = thisWB.Sheets.Add

    '--- copy the entire array to a temporary worksheet,
    '    then use Excel to copy just the single column
    '    to the given destination
    tempWS.Range("A1").Resize(UBound(srcArray, 1), UBound(srcArray, 2)) = srcArray
    tempWS.Columns(colNum).Copy Destination:=destCell.Resize(UBound(srcArray, 1), 1)

    '--- delete the temporary worksheet
    Dim previousSetting As Boolean
    previousSetting = Application.DisplayAlerts
    Application.DisplayAlerts = False
    tempWS.Delete
    Application.DisplayAlerts = previousSetting
End Sub
\$\endgroup\$
  • \$\begingroup\$ I like the out of the box thinking, but I feel like in a case where I would write the data I want somewhere else, it would be simpler and perform better if I instead wrote the values I want into a brand new array and pasted that entire array into the area of the worksheet I want to include it. The main reason I don't simply overwrite the entire worksheet with the finished array is that it contains formulas. \$\endgroup\$ – Iain Saunders Sep 20 '16 at 17:55
0
\$\begingroup\$

I found a way to write a specific column to the worksheet without a loop but it does involve an additional loop and array within the code itself. I don't know that this is actually more efficient so if anyone has comments or feedback, I would really appreciate it.

The original section looks like this:

    For rowFirstArray = 1 To UBound(firstArray, 1)
        ThisWorkbook.Worksheets(1).Cells(rowFirstArray, 4).Value = firstArray(rowFirstArray, 4)
    Next rowFirstArray
    Erase firstArray

Now within the code I loop the column of data I want into a new array, which I have given two dimensions to ensure that they adhere to the rows and columns (table) layout for writing to the worksheet:

    Dim arrayToPaste As Variant
    Dim i As Long
    ReDim arrayToPaste(UBound(firstArray, 1), 1)
    For i = LBound(firstArray, 1) To UBound(firstArray, 1)
        arrayToPaste(i, 1) = firstArray(i, 4)
    Next i

This allows me to write the one dimension array as a single column to the worksheet, leaving the rest of the worksheet unaffected:

    With ThisWorkbook.Worksheets(1)
        .Range(.Cells(1, 4), .Cells(UBound(firstArray, 1), 4)).Value = arrayToPaste
    End With

I will be sharing the next revision of my code in another post for review and hopefully to provide help to others facing similar challenges.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.