More fun with arrays

[mountainman88]

I would like an array that takes this table (i will call it TableA):

GrandTotal	Total1	Total2	(empty cell)	Total3
Total1	Apples	Beatles		Cats
Total2	Bananas	Stones		Who
Total3	Cherries

<tbody>
</tbody>

<tbody>
</tbody>

(would ideally like a msgbox to ask the sheetname and first cell of where TableA is located)

and turns TableA into a 2d array called 'TableA' where:

Row 1 of the array is the TableA contents sorted as follows:

GrandTotal

Total1

Apples

Bananas

Cherries

Total2

Beatles

Stones

(empty)

Total3

Cats

Who

<tbody>
</tbody>

(Notice any items already in the top row of TableA are ignored and not duplicated when in the format above)

and

Row 2 of the array contains:

- 'total' if the row 1 array item is on the top of TableA eg. 'GrandTotal, Total1 etc'
- 'data' if the row 1 array item is NOT on the top row of TableA
- 'blank' if the row 1 array item is empty (ie left a blank column in TableA) like between stones and Total3

I would like the array to exclude any other 'blanks' eg under Stones or Who. Just include the 'blanks' in the top row of TableA..

The array should look like this:

GrandTotal	Total1	Apples	Bananas	Cherries	Total2	Beatles	Stones	(empty)	Total3	Cats	Who
Total	Total	Data	Data	Data	Total	Data	Data	Blank	Total	Data	Data

<tbody>
</tbody>

hope this makes sense, should test you guys ha

 

[mountainman88]

I should mention that TableA is NOT a table object, its just a range of normal excel data starting in the cell and sheet given through the message box request.

 

[MickG]

Try this:-
Results on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG24Jun12
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray() [COLOR="Navy"]As[/COLOR] Variant, Loc [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] Range
Loc = InputBox("Enter Sheet name, ""comma"" and cell address" & vbLf & "Exp:- Sheet1,A10", "Sheet and Address", "Sheet name ""Comma"" and cell Address")
Sp = Split(Loc, ",")
[COLOR="Navy"]Set[/COLOR] R = Range(Sp(1))
[COLOR="Navy"]With[/COLOR] Sheets(Sp(0))
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(R.Address, Cells(R.Row, Columns.Count).End(xlToLeft))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
   [COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
     .Add Dn.Value, ""
   [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets(Sp(0))
[COLOR="Navy"]Set[/COLOR] Rng = .Range(.Cells(R.Row, R.Column), .Cells(Rows.Count, R.Column).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
  
    [COLOR="Navy"]For[/COLOR] Ac = 0 To 4
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Dn.Row > R.Row And Not .exists(Dn.Offset(, Ac).Value) [COLOR="Navy"]Then[/COLOR]
                c = c + 1
                ReDim Preserve Ray(1 To 2, 1 To c)
               Ray(1, c) = Dn.Offset(, Ac).Value
            [COLOR="Navy"]ElseIf[/COLOR] Dn.Row = R.Row [COLOR="Navy"]Then[/COLOR]
                c = c + 1
                ReDim Preserve Ray(1 To 2, 1 To c)
                Ray(1, c) = Dn.Offset(, Ac).Value
            [COLOR="Navy"]End[/COLOR] If
         [COLOR="Navy"]Next[/COLOR] Dn
    [COLOR="Navy"]Next[/COLOR] Ac

[COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(Ray, 2)
    [COLOR="Navy"]If[/COLOR] .exists(Ray(1, Ac)) And Not IsEmpty(Ray(1, Ac)) [COLOR="Navy"]Then[/COLOR]
          Ray(2, Ac) = "Total"
    [COLOR="Navy"]ElseIf[/COLOR] Not .exists(Ray(1, Ac)) [COLOR="Navy"]Then[/COLOR]
        Ray(2, Ac) = "Data"
    [COLOR="Navy"]ElseIf[/COLOR] IsEmpty(Ray(1, Ac)) [COLOR="Navy"]Then[/COLOR]
       Ray(2, Ac) = "Blank"
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Ac

 Sheets("Sheet2").Range("A1").Resize(2, UBound(Ray, 2)).Value = Ray
[COLOR="Navy"]End[/COLOR] With



[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[mountainman88]

Hey thanks, can’t wait to try it out later!