looking for help with macro combining formula, collapsing and printout features

[jazziz]

Hello everyone,

I like to ask for your help in constructing following macro, where filling a formula, expansion and printout are combined. I could puzzle some parts but am majorly stuck trying to do the following:

The setup:
Sheet “Analysis”,
· column B: for all cells a formula is returning “externe calc” or empty
· column A: every cell is an identifier number

Sheet “ZB”,
· I like to paste in cell $D$2 the range of identifiers, as shown in column A/Sheet Analysis, that have a corresponding “externe calc” in column B
· This should happen as follows: get the first identifier, place it in cell $D$2, --by doing this, data linked to this identifier will be used in the same sheet ZB. This data will occur in a given segment, as the sheet is organized in different blocks (rows) that are collapsed. At this point, I want to expand the segment where the data is shown (keeping the other segments collapsed) and print the sheet.
· After these actions, the following identifier should be pasted in cell $D$2, followed by the same sequence.

I would greatly appreciate any help in this. Of course, further clarifications re the setup are available if needed.

Thanks so much in advance for your time and help.

Kind regards,

 

[SirJB7]

Hi, jazziz!
Consider uploading a sample file (including manual examples of desired output if applicable), it'd be very useful for those who read this and might be able to help you. Thank you.
Regards!

 

[jazziz]

Hi,

I have uploaded a sample file, with Sheets Analysis and ZB
In addition to the setup explained in my initial message, I like to add the following (bold point 5.)

So the sequence i like to run is:
1. retrieve and paste identifier in $D$2 in Sheet/ZB
2. the data linked to that identifier will be used in calculations in sheet ZB. The segment in which calculations will occur in accordance to the date in Sheet Analysis/ $A$2.
3. That segment only should then expand
4. The sheet as seen as such should be printed
5. The value calculated in Sheet ZB/ O303 should be pasted back in Analysis/N4, in the corresponding identifier
Note: the row to retrieve the value in Sheet ZB varies according to the date in $A$2 Sheet Analysis

I believe this macro encompasses a lot of steps, not sure if this can run in once. Any help or advice is greatly appreciated!
thanks a lot for your time,
kind regards

 

[SirJB7]

Hi, jazziz!
I happened to imagine (and manually tested) a quick and dirty way to do it, and as I haven't done this before I don't know if there's a more elegant solution. I'll try to get back to you tomorrow night with a first attempt.
Regards!

 

[jazziz]

thank you SirJB7, any help is appreciated

 

[SirJB7]

Hi, jazziz!

When I said tomorrow you've read tomorrow? Naaah, error, beep: you should have read next week. Sorry, been absent a few days due to a proposal that I couldn't reject (5 day vacation trip).

Give a look at this file:
https://dl.dropboxusercontent.com/u... sample file (for jazziz at chandoo.org).xlsm

This is the code:

Option Explicit
 
Sub ExpandAndPlay()
    ' constants
    Const ksWSSource = "Analyse"
    Const kiColumnKey = 2
    Const ksDate = "A2"
    Const ksCalculation = "N4"
    Const ksWSTarget = "ZB "
    Const ksKey = "D2"
    Const kiColumnDate = 1
    Const kiColumnCalculation = 15
    ' declarations
    Dim dDate As Date, nCalculation As Single, iKey As Integer
    Dim I As Long, J As Long
    ' start
    dDate = Worksheets(ksWSSource).Range(ksDate).Value
    ' process
    For I = 4 To Worksheets(ksWSSource).Rows.Count
        ' quit at 1st empty
        If Worksheets(ksWSSource).Cells(I, 1).Value = "" Then Exit For
        ' retrieve key
        iKey = Worksheets(ksWSSource).Cells(I, kiColumnKey).Value
        With Worksheets(ksWSTarget)
            ' put key
            .Range(ksKey).Value = iKey
            ' find row
            J = .Cells.Find(dDate, .Cells(1, kiColumnDate), xlValues, xlWhole).Row
            ' retrieve calculation
            nCalculation = .Cells(J, kiColumnCalculation).Value
            Worksheets(ksWSSource).Range(ksCalculation).Value = nCalculation
            ' collapse all groups
            .Outline.ShowLevels 1
            ' expand found group
            .Rows(J - 1).ShowDetail = True
            ' print
            .PrintOut , , , True
        End With
    Next I
    ' end
    Beep
End Sub

I suppose that this isn't exactly what you're looking for but I hope you'd be able to adjust it to your requirements. As you didn't mention how to retrieve the key value, I simply took each value in column B of worksheet Analyse from row 4 until 1st blank, then put it into cell D2 of worksheet "ZB " (BTW, funny adding an empty space at the end of the worksheet name?), found the row where the date of 1st WS is 1st column of 2nd WS, put the value of column O and that row in cell N4 of 1st WS, collapsed all but external level in 2nd WS and displayed the group corresponding to the found row and then printed the WS in preview mode.

As your specs where not fully clear about which code retrieved, which calculations performed (lots of formulas with DIV/0 error), I think that this overview will help you build your solution.

Regards!

 

[jazziz]

Hi SirJB7 !

Thank you so much for your efforts. This is almost running as intended. Unbelievable.

A couple of small Points remain, I believe

What happens is that the value nCalculation that should be pasted back into Sheet Analyse column N, starting on row 4, gets overwritten as the macro moves through the identifiers.
Rather the first should go in N4, then N5,N6..; in the sample: N4 through N9, then blancs till N13.

The expand; collaps works wonderfully. I do get a printview though, which i have to Close for the macro to continue. Could that be changed to a real printout (without preview Phase)?

Your help is great. Thank you.
jazziz

 

[SirJB7]

Hi, jazziz!

Download again the updated file from same previous link.

The fixed code is this:

Option Explicit
 
Sub ExpandAndPlay()
    ' constants
    Const ksWSSource = "Analyse"
    Const ksDate = "A2"
    Const kiColumnKey = 2
    Const kiColumnCalculationSource = 14
    Const ksWSTarget = "ZB "
    Const ksKey = "D2"
    Const kiColumnDate = 1
    Const kiColumnCalculationTarget = 15
    ' declarations
    Dim dDate As Date, nCalculation As Single, iKey As Integer
    Dim I As Long, J As Long
    ' start
    dDate = Worksheets(ksWSSource).Range(ksDate).Value
    ' process
    For I = 4 To Worksheets(ksWSSource).Rows.Count
        ' quit at 1st empty
        If Worksheets(ksWSSource).Cells(I, 1).Value = "" Then Exit For
        ' retrieve key
        iKey = Worksheets(ksWSSource).Cells(I, kiColumnKey).Value
        With Worksheets(ksWSTarget)
            ' put key
            .Range(ksKey).Value = iKey
            ' find row
            J = .Cells.Find(dDate, .Cells(1, kiColumnDate), xlValues, xlWhole).Row
            ' retrieve calculation
            nCalculation = .Cells(J + 1, kiColumnCalculationTarget).Value
            Worksheets(ksWSSource).Cells(I, kiColumnCalculationSource).Value = nCalculation
            ' collapse all groups
            .Outline.ShowLevels 1
            ' expand found group
            .Rows(J - 1).ShowDetail = True
            ' print
            .PrintOut , , , True
        End With
    Next I
    ' end
    Beep
End Sub

My only doubt is if the next line at the "retrieve calculation" comment should have J or J+1 as index. Could you check it and adjust properly? With the data provided (that it's always 30/09/2013) the found row is always 302, so I don't know how you want it to behave.

Regards!

 

[jazziz]

Hoi SirJB7, i got it to work as wanted. Awesome your help. thanks so much.
Could add an additional IFcondition in the FOR segment.

The printout gave me initially some problem, as it returned the printpreview, but that was solved by
.PrintOut copies:=1 iso .PrintOut , , , True
Again, thank you, i could not have done it without your help.

 

[SirJB7]

Hi, jazziz!
Glad you solved it. Thanks for your feedback and for your kind words too. And welcome back whenever needed or wanted.
Regards!