Transfer from Excel to array and back to Excel

[rotary]

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.

 

[Quehay]

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. . .

[tt]
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&quot.Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
Range("F2&quot.Select
Selection.Copy Destination:=Range("F3:F6&quot
'Sum down columns at bottom
Range("A7&quot.Select
ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("A7&quot.Select
Selection.Copy Destination:=Range("B7:F7&quot

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&quot.CurrentRegion

With rngXLCurrent
.Style = "Currency"
.EntireColumn.AutoFit
.BorderAround xlDouble, xlThick
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With

With Range("A1:F1&quot
.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&quot

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
[/tt]

 

[cLocKwOrkPRO]

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&quot

Do While (currentArrayLocation < sizeOfArray)
Do While (nameCounter < numOfNames)
Range(rangeLettersArray(nameCounter) &amp; rowNumber).value = currentArray(currentArrayLocation).names(nameCounter)
nameCounter = nameCounter + 1
Loop
Range(rangeLettersArray(nameCounter) &amp; 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

 

[rotary]

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