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]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG12Sep06
[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"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    ReDim Ray(1 To Rng.Count * Columns.Count, 1 To 3)
    [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
                Ray(c, 1) = Dn: Ray(c, 2) = Format(Cells(1, Ac.Column), "dd-mmm"): Ray(c, 3) = 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) = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[k.03a]

Thanks Mick. Unfortunately I can't make it work.

When I run it in sheet 1, I get a "Run-time error '7': Out of memory" error.

I have 5000 towns and 500 dates, is this a possible cause?

 

[MickG]

That's a lot of cells.
Try altering the similar line to this.
The result rather depends on how many cells have "warning" or "stopped" in them.
If its greater the the rows.count, there will be an error, but if that was the case you could probably transfer the extra data to new columns, by altering the code.

ReDim Ray(1 To Rows.Count, 1 To Columns.Count)

Mick

 

[k.03a]

Still out of memory

I've got 4 gigs of ram and only about 1% of cells should have in "warning" or "stopped" status so I thought memory shouldn't really be the issue...?

 

[k.03a]

Actually I get the same error even when none of the cells show "warning" or "stopped"

 

[MickG]

What line does it stop on

 

[k.03a]

I only get the exact same "Run-time error '7': Out of memory" error message.

Does '7' indicate the line number? If not, how can I know where it stops?

Thanks a lot for your help

 

[MickG]

Usually (not always) when you get an error, the error Dialog box appears, with an option to "End" or Debug", if you click "Debug" a yellow line appears in the code where the error took place.
When I ran the code with an extended range,the code failed (with your error) on the line:-
redim ray (1 to rng.count* column.count, 1 to columns .count)
Because the (rng.count* column.count") was greater the the rows in the sheet.
If you open the VB editer , and step through the code by clicking in the code window and then continually clicking "F8" , you may find where its failing ealy on, obvioulsy if its in the loop it will take a long time.
So you could try clicking "F5" after you click the Code window, which will run the code, and you may then see where it fails because of the Yellow line.
Personally I would start with a small example of you data and see if the code runs at all.
mick

 

[k.03a]

When executing on a very limited number of cells I get a new error (run-time error 9: subscript out of range).

Running through the code and pressing F8 continually gets me through the whole code and only displays the error message when reaching the End If or End Sub lines.