Write from array to cells using Excel VBA

16,398

To write vertically, you need to have a 2D array, and a properly sized target. So (completely UNtested):

ReDim CurrencyArray(0 To myCollection.Count, 1 to 1)
For element =  1 To myCollection.Count
   CurrencyArray(element, 1) = myCollection(element)
Next element

'You can put the header in the first cell of an array where the first dimension is zero-based
CurrencyArray(0,1) = "Sum Currency"

Set Summary = Range("M1").Resize(ubound(currencyarray,1)+1)
 Summary.Value = CurrencyArray

The other option, would be to TRANSPOSE your single dimensioned array. But there are limits as to how large an array you can transpose; and, doing it the above way, when you have to write the elements to the array from the collection individually anyway, saves that step.

Share:
16,398
user24555
Author by

user24555

Updated on June 04, 2022

Comments

  • user24555
    user24555 almost 2 years

    I need to write from an array to Excel cells down.

    I have three values in the array and I would like to write it in cells that it will look like that:

    EUR
    GBP
    USD
    

    Code:

    On Error Resume Next
    For Each element In CurrencyArray
        myCollection.Add Item:=element, Key:=element
    Next element
    On Error GoTo 0
    
    ReDim CurrencyArray(1 To myCollection.Count)
    For element = 1 To myCollection.Count
       CurrencyArray(element) = myCollection(element)
    Next element
    
    
    Set Summary = Range("M1")
    Summary.Value = "Sum Currency"
    

    At this point I would like to write the values to the cells.

    ReDim CurrencyArray(0 To myCollection.Count, 1 To 1)
    For element = 1 To myCollection.Count
    CurrencyArray(element, 1) = myCollection(element)
    Next element
    
    
    CurrencyArray(0, 1) = "Sum Currency"
    
    Set Summary = Range("M1").Resize(UBound(CurrencyArray, 1) + 1)
    'Sum currency values
    Dim Count As Integer
    Dim SumArray As Variant
    
    For Each element In CurrencyArray
     For Count = 2 To lRow
        If ws.Cells(Count, 5) = element Then
          SumArray = SumArray + ws.Cells(Count, 6)
        End If
     Next Count
    Next element
    
    
    Summary.Value = CurrencyArray
    

    It should look like:

    EUR 1000
    GBP 500
    YEN 100
    

    The problem is that I have a spreadsheet with different values, but I'm not allowed to edit the spreadsheet except with VBA.

    Currency Amount  
    EUR      1000  
    EUR      100  
    EUR      12  
    EUR      70  
    GBP      40  
    GBP      20
    

    I have to filter the different currencys and sum up the amounts of the currencys. Then I would like to set it to the right site of the excel sheet.

    EUR      1182  
    GBP      60
    

    but I don't know in advance how many currencies will be there or how big the amount is. At first I would like to filter the duplicates and then sum up the amounts of money depending on the currency.