CODEWITHSUNDEEP
arraysexcelvbamultidimensional-array
Austin Jones
Austin Jones

Reputation: 709

VBA multidimensional array, why is the first value of second dimension being duplicated into first dimension's first value

I'm at a loss here. I have a macro that stores two sets of data into a multidimensional array then opens a new workbook, and loops through the array placing data in cells. The problem I have is the first entry in the first dimension of the array is a duplicate of the first entry of the second dimension. Here's an image of the results:

enter image description here

cell A1 should actually be HD Supply, but for some reason it's being overwritten? Any help on why this is happening, and tips are greatly appreciated. I'm fairly new to VBA and Multidimensional arrays are somewhat foreign to me, so I think it's related to my pull function, and the setup of the multidimensional array.

Here's my code:

Option Explicit

'Variable Definitions ***********************************************************
Dim WorkbookSize As Long 'Var to hold number of rows in worksheet, used primarily to control loops
Dim wb As Workbook 'var to hold workbook object
Dim TempPath As String 'var to hold local temp path to store newly created workbook
Dim i As Integer 'var used as counter for loops
Dim c As Integer 'var used as counter for loops
Dim activeBook As String 'var to hold new workbook name
Dim values() 'array for pull data

'Main Driver
Sub Main()
    'set current workbook as active workbook
    Dim currentWorksheet As Worksheet
    Set currentWorksheet = ActiveSheet

    WorkbookSize = size(currentWorksheet) 'Run function to get workbook size

    values = pull(currentWorksheet, WorkbookSize) 'Run sub to pull data
    push create(), values
End Sub

'Get size of Worksheet
Function size(sh As Worksheet) As Long
    size = sh.Cells(Rows.Count, "A").End(xlUp).Row
End Function

'Create workbook
Function create() As Workbook
    Set wb = Workbooks.Add
    TempPath = Environ("temp") 'Get Users local temp folder
    With wb
        .SaveAs Filename:=TempPath & "EDX.xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        .ChangeFileAccess Mode:=xlReadOnly, WritePassword:="admin"
    End With

    Set create = wb
End Function

'pull data
Function pull(pullFromSheet As Worksheet, size) As Variant
    Dim code() As Variant
    ReDim code(size - 1, size - 1)
    c = 1
    For i = 1 To size
    'Check code column for IN and Doctype column for 810
        If pullFromSheet.Cells(i, 9).Value = 810 And pullFromSheet.Cells(i, 17).Value = "IN" Then
            code(c - 1, 0) = pullFromSheet.Cells(i, 3).Value 'store in array
            code(0, c - 1) = pullFromSheet.Cells(i, 18).Value 'store in array
            c = c + 1
        End If
    Next i
    pull = code
End Function

'push data to new workbook
Sub push(toWorkbook As Workbook, ByRef code() As Variant)
    'activeBook = "TempEDX.xlsm"

    'Workbooks(activeBook).Activate 'set new workbook as active book
    Dim newSheet As Worksheet
    Set newSheet = toWorkbook.Sheets(1)
    Dim txt As String
    For i = 0 To UBound(code)
        newSheet.Cells(i + 1, 1).Value = code(i, 0)
        newSheet.Cells(i + 1, 2).Value = code(0, i)
    Next i
    newSheet.Activate 'make new sheet active for the user
End Sub

Upvotes: 0

Views: 280

Answers (2)

Scott Craner
Scott Craner

Reputation: 152465

I think you are misunderstanding how 2 dimensional arrays work. The first is the number of "rows" and the second the number of "columns" not each is its own column.

So you want to redim code:

ReDim code(1 To size, 1 To 2)

Then simply assign it thuse:

Function pull(pullFromSheet As Worksheet, size) As Variant
    Dim code() As Variant
    ReDim code(1 To size, 1 To 2)
     For i = 1 To size
    'Check code column for IN and Doctype column for 810
        If pullFromSheet.Cells(i, 9).Value = 810 And pullFromSheet.Cells(i, 17).Value = "IN" Then
            code(i, 1) = pullFromSheet.Cells(i, 3).Value  'store in array
            code(i, 2) = pullFromSheet.Cells(i, 18).Value 'store in array
         End If
    Next i
    pull = code
End Function

Then when assigning the values to the new sheet you do not need to loop, just assign it to the range:

Sub push(toWorkbook As Workbook, ByRef code() As Variant)
    'activeBook = "TempEDX.xlsm"

    'Workbooks(activeBook).Activate 'set new workbook as active book
    Dim newSheet As Worksheet
    Set newSheet = toWorkbook.Sheets(1)
    newSheet.Range("A1").Resize(UBound(code, 1), 2).Value = code
    newSheet.Activate 'make new sheet active for the user
End Sub

Upvotes: 1

cybernetic.nomad
cybernetic.nomad

Reputation: 6368

Do you actually need the data in a diagonal across the array? As it stands after the first loop you fill code(1,0) and code(0,1), then code(2,0) and code(0,2), then code(3,0) and code(0,3) and so on...

The table you generate indicates this is not the case. I would use the following code:

ReDim code(size - 1, 2)
For i = 1 To size
'Check code column for IN and Doctype column for 810
    If pullFromSheet.Cells(i, 9).Value = 810 And pullFromSheet.Cells(i, 17).Value = "IN" Then
        code(i - 1, 0) = pullFromSheet.Cells(i, 3).Value 'store in array
        code(i - 1, 1) = pullFromSheet.Cells(i, 18).Value 'store in array
    End If
Next i

Upvotes: 1

Related Questions