selective unpivot macro

[k.03a]

Hi all,

I need to build a quick macro but I don't know any VBA...

Basically I have in Sheet 1 towns as lines and dates as columns. For each date and each city I have a status ("ok","warning" and "stopped")

e.g.

1 sept 2 sept 3 sept 4 sept
New York ok ok ok stopped
Tokyo ok ok ok ok
London ok warning ok ok
Paris ok ok ok ok


I would like to have in sheet 2, a summary of only the "warning" or "stopped" towns, in an unpivotted format (for a database). I can't also take the "ok" ones because then I'll have more than a million lines.

e.g.

Town Date Status
New York 4 sept stopped
London 2 sept warning


Any ideas?

Thanks !

 

[MickG]

Rows.count in XL 2007 gives you over a million rows. if you use (xl 2007) "rows.count" for the size off a Variant Array as in this code, you will get this error.
The modified code below limits the rows in the Array to 60000, after this any remaining results will be placed in a new column.
This worked for me for 10k rows & 200 columns with an expected result of 70k lines.
If does not work for you perhaps you could show a limited example of your data, that it won't work on.

[COLOR="Navy"]Sub[/COLOR] MG13Sep02
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] AcRng [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] col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Num
col = 1
Num = 1
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    ReDim Ray(1 To 60000, 1 To Columns.Count)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]Set[/COLOR] AcRng = Range(Cells(Dn.Row, 2), Cells(Dn.Row, Columns.Count).End(xlToLeft))
       
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ac [COLOR="Navy"]In[/COLOR] AcRng
            [COLOR="Navy"]If[/COLOR] Ac = "warning" Or Ac = "stopped" [COLOR="Navy"]Then[/COLOR]
                c = c + 1
                [COLOR="Navy"]If[/COLOR] c Mod 60000 = 0 [COLOR="Navy"]Then[/COLOR] col = col + 3: Num = Num + 1: c = 1
                  Ray(c, col) = Dn: Ray(c, col + 1) = Format(Cells(1, Ac.Column), "dd-mmm"): Ray(c, col + 2) = Ac
                [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]If[/COLOR] c > 0 [COLOR="Navy"]Then[/COLOR]
    Sheets("Sheet2").Range("A1").Resize(c, 3 * Num) = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[k.03a]

Mick,

Your patience is really appreciated. Unfortunately I still get the out of memory message (even with 5 rows and 5 columns). Would it be easier if I sent you the simplified file so you could find out exactly what's going on?

 

[MickG]

If you would like to post your File , please do so through a file sharing Site Like (4shared.com) and in an ".xls" format.
Regards Mick

 

[k.03a]

There you go !

http://www.4shared.com/file/ksho_xz0/Template_halted_sites_13.html

Thanks a lot !

 

[MickG]

Two things :-
Can you send the file ".xls" Format and from another File sharing site, I've just had a "Norton" warning of a potential malicious attack while opening this site.
Sorry about that.
Mick

 

[k.03a]

Oh yes sorry.

Here it is:


http://www.4shared.com/document/SCltEIkC/Template_halted_sites_13.html

 

[MickG]

Sorry thats still the same site, and it actually the second time I've had a problem with this "4shared.com", Someone else on this site said "Norton" had found a problem, but I put it down as a one off, I'm not so sure now.
Mick

 

[k.03a]

Does this work?
http://www.mediafire.com/?236m7gu07jb3l7g

If not, I've also quickly created a hotmail account and sent it to that address:

address: mickgtemp@hotmail.co.uk
password: temppassword

 

[MickG]

Two things, You have the code in the wrong sheet.
Place it in the sheet :- "Input (Mohamed)"
and at the bottom of the code change the sheet Name from "sheet2" to "Output (Hassib)"
Run the code on this limited data then try a larger Selection.
Mick

 

[k.03a]

It works !

Fantastic Thanks!