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

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

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

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

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