How to loop through a multi dimensional array to create a record table

[tonyr63]

I have an Excel list which has a computer name field in column A and in Column B, C, D and beyond in each column it list a single specialist application name. Many Computer names do not have any specialist apps so there is nothing in B, C, D and some computer names have up to 12 or more specialist apps.

I would like to use VBA to provide me a new list on a new worksheet which lists on each row the computer name and each of its specialists apps as a separate record. E.G 3 computers as follows

Computer A has APP1, App2 and App3, Computer B as no Apps and Computer C has just App1. The output I am looking for written to a new sheet is

Computer A, App1,
Computer A, App2
Computer A, App3
Computer C, App1

The challenge I have is not knowing for each row how many elements my array should have and the best looping structure to use to populate the arrays and to write them back to the new sheet.

Any Suggestions would be most appreciated.

 

[tonyr63]

I've tried the following code which attempts to detect for each row how many column fields contain data and copy them to a 2 dimensional array,
This is as far as i got until I hit the dreaded Array type mismatch error message and I can't see why this is happening with a variant type.


ActiveSheet.Range("A2").Select
Selection.CurrentRegion.Name = "CompName"
Set CompName = ActiveSheet.Range("CompName")
ctr = 0


For j = 1 To CompName.Rows.Count
If Not CompName.Cells(j, 1).Offset(0, 3).Value = "" Then
ctr = ctr + 1
LastCol = CompName.Cells(j, 1).Offset(0, 3).End(xlToRight).Column
Span = LastCol - 3
x = CompName.Cells(j, 1).Value
For i = 1 To Span
y = CompName.Cells(j, 1).Offset(0, i + 2).Value
MyArr(ctr, i) = MyArr(x, y)
ctr = ctr + 1
Next
End If
Next j


End Sub

 

[tonyr63]

I've tried the following code which attempts to detect for each row how many column fields contain data and copy them to a 2 dimensional array,
This is as far as i got until I hit the dreaded Array type mismatch error message and I can't see why this is happening with a variant type.


ActiveSheet.Range("A2").Select
Selection.CurrentRegion.Name = "CompName"
Set CompName = ActiveSheet.Range("CompName")
ctr = 0


For j = 1 To CompName.Rows.Count
If Not CompName.Cells(j, 1).Offset(0, 3).Value = "" Then
ctr = ctr + 1
LastCol = CompName.Cells(j, 1).Offset(0, 3).End(xlToRight).Column
Span = LastCol - 3
x = CompName.Cells(j, 1).Value
For i = 1 To Span
y = CompName.Cells(j, 1).Offset(0, i + 2).Value
MyArr(ctr, i) = MyArr(x, y)
ctr = ctr + 1
Next
End If
Next j


End Sub

 

[ukmikeb]

Hi

This code :-

Sub Tonyr63()
'
' Tonyr63 Macro
'
Dim CellA As Range
Dim Rng As Range
Dim Col As Long, Rw As Long, X As Long
Dim Comp As Variant

'  This is the maximum of used columns in UsedRange
X = ActiveSheet.UsedRange.Columns.Count

Rw = 1

' Cycle though all Cells in Coulmn A
For Each CellA In ActiveSheet.UsedRange.Resize(, 1)

' Store  the value of current Computer cell (Column A)
    Comp = CellA.Value

' Cycle though row Cells from Column B onwards
    For Col = 2 To X
' Exit For .. Next, if cell in row is empty
    If IsEmpty(CellA.Offset(, Col - 1).Value) Then
        Exit For
    End If
' Store  the value of current App cell (Column B onwards) by offsetting from Column A 
    App = CellA.Offset(, Col - 1).Value
' Increment the Row for output
    Rw = Rw + 1

' Store Computer/App combination in Columns AA/AB
    Range("AA" & Rw).Resize(, 2) = Array(Comp, App)
Next Col

Next CellA
'
End Sub

mimics your process but stores the output in Columns AA and AB.

If you set a breakpoint on the first statement after each of the For statements youwill then be able to step through the code and see what is happening as it executes.

hth

 

[MickG]

Try:-
Results sheet2

[COLOR="Navy"]Sub[/COLOR] MG30Jan46
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] RngAc       [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ac          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ray()       [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
   [COLOR="Navy"]Set[/COLOR] RngAc = Range(Range("B" & Dn.Row), Cells(Dn.Row, Columns.Count).End(xlToLeft))
       [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ac [COLOR="Navy"]In[/COLOR] RngAc
            c = c + 1
            ReDim Preserve Ray(1 To 2, 1 To c)
            Ray(1, c) = Dn
            Ray(2, c) = Ac
     [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] Dn


Sheets("Sheet2").Range("A2").Resize(c, 2) = Application.Transpose(Ray)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[tonyr63]

Hello Mike

I really appreciate you providing the code sample which has really shown me that I am not understanding Array's properly.
What I was trying to do was to fill out a two dimensional array for writing back to a new sheet or range and was struggling to fill out each element in the array getting the type mismatch error. Your example works very well and fully achieves my immediate objective of processing a large amount of Audit data. I have a brief question to help me better learn from you sample if you don't mind.

1. You have not dimensioned App I presume this was an unintentional oversight.
2. You have not dimensioned any Array variable but just used the array function to create an array for rewriting the captured values. This way you have avoided the problem of having to redimension arrays which was causing me so much confusion.
3. Is it eash to resize the range CellA so it is effectively collecting data from row 2 onwards as the 1st row has field headings?

Thank you very much for the assistance provided which has been very helpful and greatly appreciated.

 

[tonyr63]

Hi Mick

Thanks for taking the time to send through sample code. I will look through over the weekend to see what I can learn from you example.

Many Thanks

Anthony

 

[ukmikeb]

Anthony

You're welcome.

1. You have not dimensioned App I presume this was an unintentional oversight.
2. You have not dimensioned any Array variable but just used the array function to create an array for rewriting the captured values. This way you have avoided the problem of having to redimension arrays which was causing me so much confusion.

1. - Sorry that was an oversight.

2. - In this instance I didn't need to Dim the array and was just showing you how to output data in consecutive columns. I have modified the module and have specified MyArray as an array. I have set it up as MyArray(2,3) and ReDimed it when I know how many items there are to be stored. I have also given you an example of how you can determine the number of elements there are in MyArray - Ubound(MyArray,2) for the second dimension. You would use - Ubound(MyArray,1) for the first dimension.

NB IMPORTANT - I have placed a statement "Option Base 1" prior to the Module which specifies that Arrays always start at element 1 rather than element zero if you were to omit that statement. Element zero can be useful as a medium for totalling.

3. Is it easy to resize the range CellA so it is effectively collecting data from row 2 onwards as the 1st row has field headings?

Yes, I have used Offset to bypass the headings.

Here is the revised module :-

Option Base 1
Sub Tonyr63()
'
' Tonyr63 Macro
'
Dim CellA As Range
Dim Rng As Range
Dim Col As Long, Rw As Long, X As Long
Dim App, Comp
Dim I As Integer, Items As Integer
Dim MyArray()

'  This is the maximum of used Columns in UsedRange
X = ActiveSheet.UsedRange.Columns.Count

'  This is the number of used Rows in UsedRange minus Header row
Rw = ActiveSheet.UsedRange.Rows.Count - 1

'  Count the number of items in UsedRange minus Header row
I = Application.CountA(ActiveSheet.UsedRange.Offset(1, 0).Resize(Rw, X))

'  Dimension MyArray according to # of Items minus # of rows excluding header
 Items = I - Rw
 ReDim MyArray(2, Items)
 
 ' Reset Rw and I
Rw = 1: I = 0

' Cycle though all Cells in Coulmn A
For Each CellA In ActiveSheet.UsedRange.Offset(1, 0).Resize(, 1)

' Store  the value of current Computer cell (Column A)
    Comp = CellA.Value

' Cycle though all row Cells from Column B onwards
    For Col = 2 To X
' Exit For .. Next if cell in row is empty
    If IsEmpty(CellA.Offset(, Col - 1).Value) Then
        Exit For
    End If
' Store  the value of current App cell (Column B onwards)
    App = CellA.Offset(, Col - 1).Value
    I = I + 1
' Store  the values of current Comp/App in the Array
    MyArray(1, I) = Comp
    MyArray(2, I) = App
' Increment the Row for output
    Rw = Rw + 1

' Store Computer/App combination in Columns AA/AB
    Range("AA" & Rw).Resize(, 2) = Array(Comp, App)
Next Col

Next CellA
' Output contents of MyArray to columns AD/AE
    Range("AD2").Resize(UBound(MyArray, 2), 2) = Application.Transpose(MyArray)

End Sub

hth

 

[tonyr63]

Thanks again Mike

This is very helpful providing me a good example of using arrays and something I can compare to the other method you presented. I will walk through the concepts you have demonstrated as I believe arrays are very useful data structures and it will be worth my while getting to know how they work better.

I did reference a few of my VBA books but none of the aray examples I fould were particularlly useful and nothing as helpful as the directions provided by contributors to this forum.

Hopefully as I learn more I can feed something back to the forum in appreciation.

Kind Regards


Anthony

Anthony

You're welcome.





1. - Sorry that was an oversight.

2. - In this instance I didn't need to Dim the array and was just showing you how to output data in consecutive columns. I have modified the module and have specified MyArray as an array. I have set it up as MyArray(2,3) and ReDimed it when I know how many items there are to be stored. I have also given you an example of how you can determine the number of elements there are in MyArray - Ubound(MyArray,2) for the second dimension. You would use - Ubound(MyArray,1) for the first dimension.

NB IMPORTANT - I have placed a statement "Option Base 1" prior to the Module which specifies that Arrays always start at element 1 rather than element zero if you were to omit that statement. Element zero can be useful as a medium for totalling.



Yes, I have used Offset to bypass the headings.

Here is the revised module :-

Option Base 1
Sub Tonyr63()
'
' Tonyr63 Macro
'
Dim CellA As Range
Dim Rng As Range
Dim Col As Long, Rw As Long, X As Long
Dim App, Comp
Dim I As Integer, Items As Integer
Dim MyArray()

'  This is the maximum of used Columns in UsedRange
X = ActiveSheet.UsedRange.Columns.Count

'  This is the number of used Rows in UsedRange minus Header row
Rw = ActiveSheet.UsedRange.Rows.Count - 1

'  Count the number of items in UsedRange minus Header row
I = Application.CountA(ActiveSheet.UsedRange.Offset(1, 0).Resize(Rw, X))

'  Dimension MyArray according to # of Items minus # of rows excluding header
 Items = I - Rw
 ReDim MyArray(2, Items)
 
 ' Reset Rw and I
Rw = 1: I = 0

' Cycle though all Cells in Coulmn A
For Each CellA In ActiveSheet.UsedRange.Offset(1, 0).Resize(, 1)

' Store  the value of current Computer cell (Column A)
    Comp = CellA.Value

' Cycle though all row Cells from Column B onwards
    For Col = 2 To X
' Exit For .. Next if cell in row is empty
    If IsEmpty(CellA.Offset(, Col - 1).Value) Then
        Exit For
    End If
' Store  the value of current App cell (Column B onwards)
    App = CellA.Offset(, Col - 1).Value
    I = I + 1
' Store  the values of current Comp/App in the Array
    MyArray(1, I) = Comp
    MyArray(2, I) = App
' Increment the Row for output
    Rw = Rw + 1

' Store Computer/App combination in Columns AA/AB
    Range("AA" & Rw).Resize(, 2) = Array(Comp, App)
Next Col

Next CellA
' Output contents of MyArray to columns AD/AE
    Range("AD2").Resize(UBound(MyArray, 2), 2) = Application.Transpose(MyArray)

End Sub

hth