Array problems

elektor · Aug 30, 2011

I create an array named Arr. You can see it as a sheet. (There isn’t first row in the array. I added the first row in order to understand the logic of array.) This is a simple sample. In reality there are tens of thousands of products, thousands of shops and product groups. I also create the sheets named “Computers” and “Phones” according to product groups as in the follows.

But I can’t manage to transfer data from the array to sheets correctly. Firstly, I can’t manage to generate a list of unique shops, transpose and sort in to rows them as in the output samples. And then I fail to transfer other numerical values.
I need a macro to transfer the data from the array to sheets as in the output samples.
Could you help me please


This is an mirror of may array. There isn’t first row in the array. I added the first row in order to understand the logic of array. In reality there are tens of thousands of products, thousands of shops and product groups.

Excel Workbook

A

B

C

D

E

F

G

H

1

R.N.

Stock Number

Product

Units

Shops

Available in shops

Total product in available shops

Product groups

2

1

C001

CPU

Pieces

B Shop

1

3

Computers

3

A Shop

2

Computers

4

2

CP002

Cell Phone

Pieces

A Shop

3

Phones

5

3

MB003

Mainboard

Pieces

B Shop

3

6

Computers

6

K Shop

2

Computers

7

A Shop

1

Computers

8

4

PB006

Phone Battery

Pieces

B Shop

1

Phones

Sheet

Output Samples:
 I can create a sheet for each product group. I am asking you to generate a list of unique shops, transpose and sort in to rows them as in the output samples. Then to transfer other numerical values.

Excel Workbook

A

B

C

D

E

F

G

H

14

R.N.

Stock Number

Product

Units

A Shop

B Shop

K Shop

Total

15

1

C001

CPU

Pieces

2

1

3

16

2

MB003

Mainboard

Pieces

1

3

2

6

17

This sheet name is Computers

Sheet

Excel Workbook

A

B

C

D

E

F

G

22

R.N.

Stock Number

Product

Units

A Shop

B Shop

Total

23

1

CP002

Cell Phone

Pieces

3

24

2

PB006

Phone Battery

Pieces

1

25

This sheet name is Phones.

Sheet

MickG · Aug 30, 2011

Try this:-
Run from you basic data sheet.
The code requires that you have created sheets as named in column (H).
The code should fill all the sheet Headers and related data from Your Basic Data sheet.

Code:

[COLOR=navy]Sub[/COLOR] MG30Aug18
[COLOR=navy]Dim[/COLOR] Rng     [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn      [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] n       [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Ray     [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Lst     [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] K       [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Temp    [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] p [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
Application.ScreenUpdating = False
[COLOR=navy]Set[/COLOR] Rng = Range(Range("E2"), Range("E" & Rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
        .Item(Dn.Value) = Dn.Value
    [COLOR=navy]Next[/COLOR]
Ray = .Keys
[COLOR=navy]End[/COLOR] With
[COLOR=navy]Set[/COLOR] Rng = Rng.Offset(, 3)
   [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
        Sheets(Dn.Value).Range("A1:D1").Value = Range("A1:D1").Value
            [COLOR=navy]For[/COLOR] n = 0 To UBound(Ray)
                [COLOR=navy]If[/COLOR] Ray(n) = Dn.Offset(, -3) [COLOR=navy]Then[/COLOR] [COLOR=navy]Exit[/COLOR] For
            [COLOR=navy]Next[/COLOR] n
        [COLOR=navy]With[/COLOR] Sheets(Dn.Value)
            .Cells(1, 5 + n) = Dn.Offset(, -3)
            [COLOR=navy]If[/COLOR] Not .Cells("1", Columns.Count).End(xlToLeft) = "Total" [COLOR=navy]Then[/COLOR]
             .Cells("1", Columns.Count).End(xlToLeft).Offset(, 1) = "Total"
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]End[/COLOR] With
    [COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
        .Item(Dn.Value) = Dn.Value
    [COLOR=navy]Next[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Rng.Offset(, -6)
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .Keys
        p = 0
[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] Dn.Offset(, 6) = K [COLOR=navy]Then[/COLOR]
            [COLOR=navy]For[/COLOR] n = 0 To UBound(Ray)
                [COLOR=navy]If[/COLOR] Ray(n) = Dn.Offset(, 3) [COLOR=navy]Then[/COLOR] [COLOR=navy]Exit[/COLOR] For
            [COLOR=navy]Next[/COLOR] n
            Temp = IIf(Dn = "", Temp, Dn) 
            [COLOR=navy]If[/COLOR] Not .Exists(Temp) [COLOR=navy]Then[/COLOR]
                p = p + 1
                .Add Temp, p
                Sheets(K).Cells(p + 1, 5 + n) = Dn.Offset(, 4)
                Sheets(K).Cells(p + 1, 1).Resize(, 4).Value = Dn.Offset(, -1).Resize(, 4).Value
                Sheets(K).Cells(p + 1, Sheets(K).Cells(1, Columns.Count).End(xlToLeft).Column) = Dn.Offset(, 5)
            [COLOR=navy]Else[/COLOR]
                Sheets(K).Cells(.Item(Temp) + 1, 5 + n) = Dn.Offset(, 4)
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] Dn
 [COLOR=navy]End[/COLOR] With
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
Application.ScreenUpdating = True
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

elektor · Aug 30, 2011

Thanks a lot for your answer MickG.
I think I don’t explain my problem exactly because of my bad English. The first table is not an excel sheet table. It is an array created by a macro. This arrays name is Arr. Could you readjust the code?
Note: If you need the excel sheet sample, i can send it.
Thanks again.

elektor · Aug 31, 2011

Hello again MickG.
This is my original sheet sample . It’s name is “MainSheet”.
These are the things I ask to do:
If there is a available product in any shop, a new sheet named “Product groups +ML” must be created. For example: "Computers ML" and "Phones ML" sheets must be created. “Home Electronic ML” sheet must not be created because there isn’t any available Home Electronic product in the shops. As I said, in reality there are tens of thousands of products, thousands of shops and product groups. Output table structure same as my firs message above. Thanks again.

Main sheet sample:

Excel Workbook

A

B

C

D

E

F

G

H

40

R.N.

Stock Number

Product

Units

Shops

Available in shops

Total product in available shops

Product groups

41

1

C001

CPU

Pieces

B Shop

1

7

Computers

42

A Shop

2

43

M Shop

4

44

45

46

2

CP002

Cell Phone

Pieces

B Shop

3

5

Phones

47

A Shop

2

48

LCDTV025

LCD TV

Pieces

Home Electronic

49

DVDP003

DVD Player

Pieces

Home Electronic

50

3

MB003

Mainboard

Pieces

B Shop

3

6

Computers

51

K Shop

2

52

A Shop

1

53

4

PB006

Phone Battery

Pieces

M Shop

1

Phones

54

55

5

E077

Earphone

Pieces

A Shop

2

Phones

56

57

Sheet

Output sheets:
This sheet name must be "Computers ML"

Excel Workbook

A

B

C

D

E

F

G

H

I

64

R.N.

Stock Number

Product

Units

A Shop

B Shop

K Shop

M Shop

Total

65

1

C001

CPU

Pieces

2

1

4

7

66

2

MB003

Mainboard

Pieces

1

3

2

6

Sheet

This sheet name must be "Phones ML"

Excel Workbook

A

B

C

D

E

F

G

H

70

R.N.

Stock Number

Product

Units

A Shop

B Shop

M Shop

Total

71

1

CP002

Cell Phone

Pieces

2

3

5

72

2

PB006

Phone Battery

Pieces

1

73

3

E077

Earphone

Pieces

2

Sheet

MickG · Aug 31, 2011

What is the data in your array "arr" based on, as I can't see the array, except if posted to a sheet thats what I can work on.
I could asign the sheet data to an array and work with that , but if the data came initially from a sheet, why not work with the sheet.
The best thing to do is post your array to the sheet and then run the code, based on the sheet data, then we can try to run the code based on your Array.
Where did the data come from and How did you asign the data to the array.
Mick

MickG · Aug 31, 2011

NB:- I've just seen you latest post.
What happens if you create a sheet, because there are products and later on the data alters and there are no products, but you still have the sheet, do you then want to delete it.
Whats the problem with creating the sheet, it will show no product if there are none, but will be available when you do have some.
I also noticed you've changed the sheet by adding blank rows (this effects the code), is this how the final data will be presented.
Mick

elektor · Aug 31, 2011

MickG said:
NB:- I've just seen you latest post.
What happens if you create a sheet, because there are products and later on the data alters and there are no products, but you still have the sheet, do you then want to delete it.
Whats the problem with creating the sheet, it will show no product if there are none, but will be available when you do have some.
I also noticed you've changed the sheet by adding blank rows (this effects the code), is this how the final data will be presented.
Mick

Thank you for your effort and patience.

I wrote a code to delete all the sheets except mains sheet, when any change occur in the main sheet data. So you do ignore this problem.
If you create product group sheets that have no product, there will be hundreds of useless, mind-bending empty sheets. Besides as I said before when any change occur in the main sheet data, all sheets except main sheet are deleted by a macro I wrote.
Finally, the main sheet have the irregular blank rows. These blank rows must not be shown on the output sheets. And main sheet must be not altered.

MickG · Aug 31, 2011

Try this Based on your new Data:-
The code will create the sheets if not existing.

Code:

[COLOR="Navy"]Sub[/COLOR] MG31Aug55
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] sht     [COLOR="Navy"]As[/COLOR] Worksheet
[COLOR="Navy"]Dim[/COLOR] Temp    [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] ray     [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] i       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] j       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Temp2   [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
Application.ScreenUpdating = False
[COLOR="Navy"]With[/COLOR] Sheets("MainSheet")
  [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("H2"), .Range("H" & Rows.Count).End(xlUp))
[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] Dn <> "" And Dn.Offset(, -3) <> "" [COLOR="Navy"]Then[/COLOR]
            .Item(Dn.Value) = Dn.Value
                [COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
                [COLOR="Navy"]Set[/COLOR] sht = ActiveWorkbook.Sheets(Dn.Value & " ML")
                    [COLOR="Navy"]If[/COLOR] Err = 0 [COLOR="Navy"]Then[/COLOR]
                        sht.Cells.ClearContents
                    [COLOR="Navy"]Else[/COLOR]
                        Sheets.Add(after:=Sheets(Sheets.Count)).Name = Dn.Value & " ML"
                    [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] GoTo 0
         [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR]
'[COLOR="Green"][B]==============[/B][/COLOR]
Sheets("MainSheet").Select
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Rng.Offset(, -3)
For Each K In .Keys '[COLOR="Green"][B]loop @Sheets[/B][/COLOR]
c = 1
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
       Temp = IIf(Dn.Offset(, 3) = "", Temp, Dn.Offset(, 3))
         [COLOR="Navy"]If[/COLOR] Dn <> "" And Temp = Split(K, " ")(0) [COLOR="Navy"]Then[/COLOR]
            .Item(Dn.Value) = Dn.Value
         [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
ray = .Keys
[COLOR="Navy"]For[/COLOR] i = 0 To UBound(ray)
    [COLOR="Navy"]For[/COLOR] j = i To UBound(ray)
        [COLOR="Navy"]If[/COLOR] Left(ray(j), 1) < Left(ray(i), 1) [COLOR="Navy"]Then[/COLOR]
            Temp2 = ray(i)
                ray(i) = ray(j)
                    ray(j) = Temp2
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] j
[COLOR="Navy"]Next[/COLOR] i
 ReDim Preserve ray(UBound(ray) + 1)
 ray(UBound(ray)) = "Total"
 Sheets(K & " ML").Range("A1:D1").Value = Sheets("MainSheet").Range("A1:D1").Value
 Sheets(K & " ML").Range("E1").Resize(, UBound(ray) + 1).Value = ray
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Dn.Offset(, 3) = Split(K, " ")(0) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        Sheets(K & " ML").Cells(c, 2).Resize(, 3).Value = Dn.Offset(, -3).Resize(, 3).Value
        Sheets(K & " ML").Cells(c, 1) = c - 1
        Sheets(K & " ML").Cells(c, 5 + UBound(ray)) = Dn.Offset(, 2)
    [COLOR="Navy"]End[/COLOR] If
      Temp = IIf(Dn.Offset(, 3) = "", Temp, Dn.Offset(, 3))
         [COLOR="Navy"]If[/COLOR] Dn <> "" And Temp = Split(K, " ")(0) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]For[/COLOR] n = 0 To UBound(ray)
                [COLOR="Navy"]If[/COLOR] ray(n) = Dn [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] For
            [COLOR="Navy"]Next[/COLOR] n
                Sheets(K & " ML").Cells(c, 5 + n) = Dn.Offset(, 1)
         [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
Application.ScreenUpdating = True
MsgBox "Run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

elektor · Aug 31, 2011

Thanks MickG. It works perfectly.
I’m sorry to say this. I had to insert a column between G and H. The very last main sheet became like below. And I can't adapt your code. Could you adapt it?

Excel Workbook

A

B

C

D

E

F

G

H

I

1

R.N.

Stock Number

Product

Units

Shops

Available in shops

Total product in available shops

Product groups

2

1

C001

CPU

Pieces

B Shop

1

7

Computers

3

A Shop

2

4

M Shop

4

5

6

7

2

CP002

Cell Phone

Pieces

B Shop

3

5

Phones

8

A Shop

2

9

LCDTV025

LCD TV

Pieces

Home Electronic

10

DVDP003

DVD Player

Pieces

Home Electronic

11

3

MB003

Mainboard

Pieces

B Shop

3

6

Computers

12

K Shop

2

13

A Shop

1

14

4

PB006

Phone Battery

Pieces

M Shop

1

Phones

15

16

5

E077

Earphone

Pieces

A Shop

2

Phones

17

18

MainSheet

elektor · Aug 31, 2011

I adapt it. It's very simple.

Thank you very very much again.

Array problems

elektor

New Member

Excel Facts

MickG

MrExcel MVP

elektor

New Member

elektor

New Member

MickG

MrExcel MVP

MickG

MrExcel MVP

elektor

New Member

MickG

MrExcel MVP

elektor

New Member

elektor

New Member

Similar threads

Forum statistics

Share this page

Array problems

New Member

Excel Facts

MrExcel MVP

New Member

New Member

MrExcel MVP

MrExcel MVP

New Member

MrExcel MVP

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock