• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Excel VBA: How to create a dynamic skyline chart based on filtered range

Prima Satria

New Member
Dear Chandoo,

I got this VBA code from internet to generate skyline chart based on data source in "System" sheet.
To generate the skyline, we need to go to "Skyline" sheet and press "Generate Skyline" button. And the code works fine.

>>> Moved this thread from Ask an Excel Question to VBA Macros <<<

Code:
Option Explicit
Option Private Module
Public skydate As Range
Public axisy As Integer
Public interval As Long
Public skyrange As Range
Public skycell As Range
Public plan As Range
Public y As Integer
Public fs As Integer

Sub setarea()
Dim rangedate As Range
Dim rangearea As Range

On Error Resume Next
Set rangedate = Application.InputBox(Prompt:="Please Select Timeline Columns", Title:="Range Date", Default:=ActiveWorkbook.Names("skylinedate").RefersTo, Type:=8)
ActiveWorkbook.Names("skylinedate").RefersToR1C1Local = rangedate

Set rangearea = Application.InputBox(Prompt:="Please Select Skyline Chart Area", Title:="Range Chart Area", Default:=ActiveWorkbook.Names("skylinearea").RefersTo, Type:=8)
ActiveWorkbook.Names("skylinearea").RefersToR1C1Local = rangearea

End Sub


Sub generate()



With Range("skylinearea")
    .Clear
    .Interior.Color = Range("skylineareabg").Interior.Color
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Color = Range("skylineareabg").Offset(0, 1).Interior.Color
    End With
End With
On Error Resume Next

For Each skydate In Range("skylinedate")

    interval = skydate - skydate.Offset(0, -1)
    If Err.Number > 0 Then
        interval = skydate.Offset(0, 1) - skydate
    End If
    Err.Clear

    axisy = Range("skylinearea").Rows(Range("skylinearea").Rows.Count).Columns(1).Row

    For y = 1 To Range("listplan").Rows.Count
        Set plan = Range("listplan").Rows(y)
        Set skycell = Sheet1.Cells(axisy, skydate.Column)
        If ActiveSheet.Shapes("check2").ControlFormat.Value = 1 And Range("listcomp").Rows(y).Value = "OK" Then
            If plan <= skydate And plan > (skydate - interval) Then
                skycell = Range("listsystem").Rows(y)
                axisy = axisy - 1
                Call formatting
            End If
        End If
        If Range("listcomp").Rows(y).Value <> "OK" Then
            If plan <= skydate And plan > (skydate - interval) Then
                skycell = Range("listsystem").Rows(y)
                axisy = axisy - 1
                Call formatting
            End If
        End If
    Next
Next

Range("skylinearea").Select

End Sub

Sub formatting()

fs = Range("fontsize").Value

With skycell
    .Hyperlinks.Add anchor:=skycell, Address:="", SubAddress:=skycell.Address, ScreenTip:="Click for more detail"
    .Interior.Color = Range(Range("liststatus").Rows(y)).Interior.Color
    .Interior.Pattern = Range(Range("liststatus").Rows(y)).Interior.Pattern
    .Interior.PatternColor = Range(Range("liststatus").Rows(y)).Interior.PatternColor
    .Font.Color = Range(Range("liststatus").Rows(y)).Font.Color
    .Font.Underline = xlUnderlineStyleNone
    .Font.Bold = True
    .Font.Size = fs
    .WrapText = True
    .HorizontalAlignment = xlCenter
    With .Borders
        .LineStyle = xlContinuous
        .Color = Range(Range("liststatus").Rows(plan.Row - Range("liststatus").Row + 1)).Offset(0, 1).Interior.Color
    End With
End With

End Sub

But my boss wants to filter based on specific criteria, let's say:
- RFSU06, column C in "System" sheet
- Then generate skyline based on visible cells only (filtered range) into "Skyline" sheet

I modified the code, but it is notworking:
Code:
Sub generateX()


'Dim rng1 As Range
'Dim chartRange As Range
'Set rng1 = Sheets("System").Range("B5:M508")
'Set rng1 = rng1.SpecialCells(xlCellTypeVisible)

'Set chartRange = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)


With Range("skylinearea")
    .Clear
    .Interior.Color = Range("skylineareabg").Interior.Color
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Color = Range("skylineareabg").Offset(0, 1).Interior.Color
    End With
End With

On Error Resume Next

For Each skydate In Range("skylinedate")

    interval = skydate - skydate.Offset(0, -1)
    If Err.Number > 0 Then
        interval = skydate.Offset(0, 1) - skydate
    End If
    Err.Clear

    axisy = Range("skylinearea").Rows(Range("skylinearea").Rows.Count).Columns(1).Row

    For y = 1 To Range("F5:F508").SpecialCells(xlCellTypeVisible).Rows.Count
        Set plan = Range("F5:F508").SpecialCells(xlCellTypeVisible).Rows(y)
        Set skycell = Sheet1.Cells(axisy, skydate.Column)
        If ActiveSheet.Shapes("check2").ControlFormat.Value = 1 And Range("G5:G508").SpecialCells(xlCellTypeVisible).Rows(y).Value = "OK" Then
            If plan <= skydate And plan > (skydate - interval) Then
                skycell = Range("B5:B508").SpecialCells(xlCellTypeVisible).Rows(y)
                axisy = axisy - 1
                Call formattingX
            End If
        End If
        If Range("G5:G508").SpecialCells(xlCellTypeVisible).Rows(y).Value <> "OK" Then
            If plan <= skydate And plan > (skydate - interval) Then
                skycell = Range("B5:B508").SpecialCells(xlCellTypeVisible).Rows(y)
                axisy = axisy - 1
                Call formatting
            End If
        End If
    Next
Next

Range("skylinearea").Select

End Sub



Sub formattingX()

fs = Range("fontsize").Value

With skycell
    .Hyperlinks.Add anchor:=skycell, Address:="", SubAddress:=skycell.Address, ScreenTip:="Click for more detail"
    .Interior.Color = Range(Range("H5:H508").SpecialCells(xlCellTypeVisible).Rows(y)).Interior.Color
    .Interior.Pattern = Range(Range("H5:H508").SpecialCells(xlCellTypeVisible).Rows(y)).Interior.Pattern
    .Interior.PatternColor = Range(Range("H5:H508").SpecialCells(xlCellTypeVisible).Rows(y)).Interior.PatternColor
    .Font.Color = Range(Range("H5:H508").SpecialCells(xlCellTypeVisible).Rows(y)).Font.Color
    .Font.Underline = xlUnderlineStyleNone
    .Font.Bold = True
    .Font.Size = fs
    .WrapText = True
    .HorizontalAlignment = xlCenter
    With .Borders
        .LineStyle = xlContinuous
        .Color = Range(Range("H5:H508").SpecialCells(xlCellTypeVisible).Rows(plan.Row - Range("H5:H508").SpecialCells(xlCellTypeVisible).Row + 1)).Offset(0, 1).Interior.Color
    End With
End With

End Sub

Hope that you can help me.
Thank you very much in advance.

Prima - Indonesia
 

Attachments

  • Dynamic SH1 Skyline Overall 20230227 (CPY).xlsm
    486.3 KB · Views: 17
Last edited by a moderator:
Prima Satria
I got a minor challenge to see Your needed skyline chart - Your 'Skyline'-sheet was like empty.
... as well as You've used functions - which my Excel don't use.
But I tested something ... pure guess, of course.
Is there any reason - why You skip to use Excel's charts?
eg like below ..
Screenshot 2023-03-02 at 11.36.26.png
 
Hi Chandoo,
thanks for posting the native file for the Skyline
I could not see the skyline, as the macros are blocked. I could download the file and opened it. Is there any alternate way to open it?
1710389722389.png
 
Back
Top