Load a Multidimensional array

[fredlo2010]

Hello guys,

I am trying to create a multidimensional array. I want to go through the headers of a specific range and if the values equal another one specified for them.

In the end I want to get the values in the array and copy them to another sheet.

I can do this with a range but I want to use an array because its faster.

This is the code I have so far.


Sub createList()

Dim arr() As Variant
Dim arrHeaders As Variant
Dim lRow As Long
Dim sh As Worksheet
Dim r As Range


' Headers I want to keep
lRow = Sheets("Orders").Range("C1").CurrentRegion.Rows.Count


arrHeaders = Array("Sales order", "Name", "Record", "Order type")
ReDim arr(1 To lRow, 1 To UBound(arrHeaders))
'Loop through the headers to pic the corrct ones


For i = 1 To Sheets("Orders").Cells(1, Columns.Count).End(xlToLeft).Column
For j = 0 To UBound(arrHeaders)
If Cells(1, i).Value = arrHeaders(j) Then
' I need to figuere out this part.
arr = Cells(1, i).Resize(UBound(arr, 1), 1).Value
End If
Next
Next


End Sub

Thanks

[SamT]

Written in VBAX Editor >> UnTested:


Sub createList()
'Save up to 4 columns, in Column order, to arr, if Column Header match value in WantedHeaders

WantedHeaders = Array("Sales order", "Name", "Record", "Order type")
ULimitWantedHeaders = UBound(WantedHeaders) 'Set once, use many times

lRow = Sheets("Orders").Range("C1").CurrentRegion.Rows.Count


Redim arr(1 To lRow, 1 To ULimitWantedHeaders+1)
arrIndex = 0

For Col = 1 To LastUsedColumn of Sheets("Orders")
For HeaderNum = 0 To ULimitWantedHeaders
If Cells(1, Col).Value = WantedHeaders(HeaderNum) Then
arr(arrIndex) = Cells(1, Col).Resize(Lrow, 1).Value
ArrIndex = arrIndex + 1
End If
Next
Next
End Sub

For more speed, and to save the columns in the same order as Wanted Headers

'add
Dim ColHeaders as Variant

With Sheets("Orders")
Redim ColHeaders(1 to LastUsedColumn)
ColHeaders = Range(Cells(1,1), Cells(1, LastUsedColumn))

'Replace
For HeaderNum = 0 To ULimitWantedHeaders
For ColHeadersIndex = 0 To UBound(ColHeaders)
If ColHeaders(ColHeadersIndex) = WantedHeaders(HeaderNum) Then
arr(HeaderNum) = Cells(1, ColHeadersIndex + 1).Resize(Lrow, 1).Value
End If
Next
Next

[Bob Phillips]

I not sure I understand what you are trying to do, so I may be off with this, but you could just match against it


With Sheets("Orders")

arr = Application.Transpose(Application.Transpose(.Range(.Range("A1"), .Cells(1, .Columns.Count).End(xlToLeft))))
End With

For j = LBound(arrHeaders) To UBound(arrHeaders)
If Not IsError(Application.Match(arrHeaders(j), arr, 0)) Then
' do your stuff
End If
Next j

Dropping the range into an array seems a tad pointless as there is no looping over the range, but the rest is okay.

[fredlo2010]

Hi guys thanks for the help. I will explain the problem because I think its not clear.

I have a sheet with data. That sheet comes full with columns that I don't need. I want to remove all those unwanted columns and only keep the ones I want.
Some of those headers are even duplicates.

Here there is a sample
11110

SamT,
I tried your solution but I get an error 9' subscript out of range. on the line bellow.

arr(HeaderNum) = Cells(1, Col).Resize(Lrow, 1).Value


This is getting little complicated because I want to use a multidimensional array. I could just back and forth copying the data I need between the sheets.

I hope this makes the post more clear.

[Bob Phillips]

But loading a multi-dimensional array is trivial, so I still am not sure as to the problem.

As to the sample, why not just delete the columns you don't want before loading, you don't have to save those changes.

[fredlo2010]

Thanks for the help guys.

I was just trying to use an array for this. I already have a code for it. I just wanted to modify it. :)

This code does the job:

Option Explicit
Sub GetData()

Dim shTarget As Worksheet
Dim shSource As Worksheet
Dim arr As Variant
Dim r As Range
Dim Header As Range
Dim i As Long
Dim lRow As Long

Set shTarget = Sheets("Final Orders")
Set shSource = Sheets("Orders")

lRow = shSource.Cells(Rows.Count, "A").End(xlUp).Row
arr = Array("Sales order", "Name", "Record", "Order type")

Set Header = shSource.Cells(1, 1).Resize(1, shSource.Range("A1").CurrentRegion.Columns.Count)

For i = 0 To UBound(arr)
Set r = Header.Find(What:=arr(i))
shTarget.Cells(1, i + 1).Resize(lRow, 1).Value = r.Resize(lRow, 1).Value
Next i

' Final touch ups
With shTarget.Range("A1").CurrentRegion.Columns
.AutoFit
.Resize(1).Font.Bold = True
End With

' Release the variables
Set shTarget = Nothing
Set shSource = Nothing
Set r = Nothing
Set Header = Nothing

End Sub

Thanks

[nilem]

Hi Fredlo2010,
try

Sub GetData22()
Dim x, s$, t$, i&, j&, k&, arr
x = Sheets("Orders").Range("A1").CurrentRegion.Value
arr = Array("Sales order", "Name", "Job Site Record", "Order type")
s = "~" & Join(arr, "~") & "~"

For j = 1 To UBound(x, 2)
t = "~" & x(1, j) & "~"
If InStr(s, t) Then
k = k + 1: s = Replace(s, t, "~")
For i = 1 To UBound(x)
x(i, k) = x(i, j)
Next i
End If
Next j
Sheets("Final Orders").Range("A1").Resize(UBound(x), k).Value = x
End Sub