×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Transfer from Excel to array and back to Excel

Transfer from Excel to array and back to Excel

Transfer from Excel to array and back to Excel

(OP)
I've been trying to transfer a large amount of data from Excel to an array
for processing and then back to Excel.  I can do this by looping line by line
but I haven't been able to move the data in a single step.  Can the data be
moved in a single step?  If so, any hints on how it should be setup?

I'm trying to start with a single column of data.  Later I would like to do multiple
columns into a 2 dimensional array.

RE: Transfer from Excel to array and back to Excel

  rotary:

Here's a routine I used to take info from a grid-like set of textboxes in a VB form and drop it into Excel (which is not what you're trying to do).  The second part of the code uses the same variant to collect the Excel cell data and send it back again--this may get you on the right track.  The comments should clue you enough as to what's going on. . .


Private Sub mnuTransfer_Click()

On Error GoTo ExportToExcel_Err

Dim r%, c%, k%
Dim parrGridValues()
Dim PrintNow%
Dim SaveName$

'Excel object variables
    Dim objXLApp As Excel.Application
    Dim objXLWkb As Excel.Workbook, _
        objXLWksht As Excel.Worksheet, rngXLCurrent As Excel.Range
       
       
' Me.Hide
 
 'Get the textbox values
 FillArray parrGridValues()
     
    Set objXLApp = New Excel.Application
   
    With objXLApp
        .Visible = True
        .WindowState = xlMinimized
       .ScreenUpdating = False
       End With
 
    Set objXLWkb = objXLApp.Workbooks.Add
    Set objXLWksht = objXLWkb.Worksheets(1)
   
    With objXLWksht
        .Name = "NewBudget"
        .Cells(1, 1).Value = "July"
        .Cells(1, 2).Value = "August"
        .Cells(1, 3).Value = "September"
        .Cells(1, 4).Value = "October"
        .Cells(1, 5).Value = "November"
        .Cells(1, 5).Value = "December"
        .Cells(1, 6).Value = "TOTALS"
        
      
    k% = 0
    
        For r% = 2 To 6
            For c% = 1 To 5
                objXLWksht.Cells(r%, c%).Value = parrGridValues(k%)
                If k% = 35 Then Exit For
                k% = k% + 1
           
            Next c%
        Next r%
    
    
    
    'Sum across rows at right
        Range("F2").Select
        ActiveCell.FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
        Range("F2").Select
        Selection.Copy Destination:=Range("F3:F6")
     'Sum down columns at bottom
        Range("A7").Select
        ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
        Range("A7").Select
        Selection.Copy Destination:=Range("B7:F7")
    
    End With

'Use Sums back in VB "Grid"

ReDim parrGridValues(10)
k% = 0
c% = 6
 'Fill array with Row Sums
  For r% = 2 To 6
     parrGridValues(k%) = objXLWksht.Cells(r%, c%).Value
     k% = k% + 1
  Next r%

r% = 7
'Fill array with Column Sums
  For c% = 1 To 6
    parrGridValues(k%) = objXLWksht.Cells(r%, c%).Value
    k% = k% + 1
  Next c%

'Insert Row Sums into txtRowSum()
'Use c% for the txtRowSum index down right column
k% = 0
 For c% = 0 To 4
    txtRowSum(c%).Text = parrGridValues(k%)
    k% = k% + 1
 Next c%
 
 'Use r% for txtEntry index across bottom row
 'k% continues from last index value
 For r% = 0 To 5
    txtColSum(r%).Text = parrGridValues(k%)
    k% = k% + 1
 Next r%
 'Insert Column Sums into txtEntry()
 

  'Format the sheet with borders
  
    Set rngXLCurrent = objXLWksht.Range("a1").CurrentRegion

      With rngXLCurrent
        .Style = "Currency"
        .EntireColumn.AutoFit
        .BorderAround xlDouble, xlThick
        .Borders(xlInsideVertical).LineStyle = xlContinuous
      End With
      
    With Range("A1:F1")
        .Font.Bold = True
            
        With .Interior
             .ColorIndex = 15
             .Pattern = xlSolid
        End With
    
    End With

PrintNow% = MsgBox("Do you want to print the report now?", vbYesNo, "Excel Report")

    If PrintNow% = vbYes Then
        objXLWksht.PrintOut
    End If

' Save the spreadsheet
SaveName$ = "XLExport.xlx"



    objXLApp.DisplayAlerts = False
     
 objXLWksht.SaveAs (SaveName$)
    

 
' Quit Excel
 objXLApp.Quit

'Format all txtEntry.text values as currency $0.00
FormatTxtEntry
  Me.Show


ExportToExcel_Exit:
objXLApp.DisplayAlerts = True
objXLApp.ScreenUpdating = True
'Empty Object Variables
    Set rngXLCurrent = Nothing
    Set objXLWksht = Nothing
    Set objXLWkb = Nothing
    Set objXLApp = Nothing
     
    Exit Sub
    
ExportToExcel_Err:
    MsgBox Err.Number & ": " & Err.Description
    GoTo ExportToExcel_Exit

RE: Transfer from Excel to array and back to Excel

Basically you want to have a double loop something like this, I use a user-defined type for my array, but u can get an idea:


Public Type namesArrayType
        names(10) As String
        spent As String
End Type


Public Sub DisplayArrayOnSheet(currentArray() As namesArrayType, sizeOfArray As Integer, Optional numOfNames As Integer = 1)

    currentArrayLocation = 0
    nameCounter = 0
    originalRow = 18
    rowNumber = 18 ' select what row u wanna start at.. u   can modify the rangelettersArray also to start at the column u want
    Application.ScreenUpdating = False
    rangeLettersArray = Array("A","B","C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC")
    
    Do While (currentArrayLocation < sizeOfArray)
        Do While (nameCounter < numOfNames)
            Range(rangeLettersArray(nameCounter) & rowNumber).value = currentArray(currentArrayLocation).names(nameCounter)
            nameCounter = nameCounter + 1
        Loop
        Range(rangeLettersArray(nameCounter) & rowNumber).value = currentArray(currentArrayLocation).spent
        currentArrayLocation = currentArrayLocation + 1
        rowNumber = rowNumber + 1
        nameCounter = 0
    Loop
    Application.ScreenUpdating = True
    
End Sub

I use a couple extra things u might not need, but you get the drift.  U loop through the rows, then columns... the colums shift right for every name in the array, then down for every entry in the currentArray.

Hope that makes some sense. GL!!
-cLocKwOrk

RE: Transfer from Excel to array and back to Excel

(OP)
Thanks for the help.   My data files can be pretty large;  20,000 rows by
40 or so columns so it can take a few hours to process the data without
using arrays. (If it didn't crash)  After sitting on a offshore oil platform and searching through some books I've finally come up with a faster solution.   I don't write pretty code so I will just outline what I've done to get the processing time down to a few
minutes.

Dim  startarray() as variant
Dim  startarrayrange as range
Dim  endarray() as variant
Dim endarrayrange() as range
dim rowcount as long

Open the excel file.  

' find out how many rows to process

Set workrange = rnginput.columns(1).entirecolumn
Set workrange = intersect(workrange.parent.usedrange,workrange)
rowcount = workrange.count

'endcolumn sets size of the array
'1strow, 1stcolumn,lastrow,lastcolumn are the excel file rows
'and columns for the data

Redim startarray(1 to rowcount, 1 to endcolumn)
Set startarrayrange= activecell.range(cells(1strow, 1st column), _
cells(lastrow, lastcolumn))

redim endarray(1 to rowcount, 1 to endcolumn)
set endarrayrange=activecell.range(...........

startarray = startarrayrange.value

' do the file manipulations
endarray(i,5) = startarray(i,5)

endarrayrange.value = endarray

'store the processed data

This seems to work quickly and I haven't had my PC crash, so far.

rotary

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close