View Single Post
 
Old 10-14-2024, 09:17 AM
Logit Logit is offline Windows 10 Office 2007
Expert
 
Join Date: Jan 2017
Posts: 591
Logit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the rough
Default

Based on your last posted workbook (Post #4) the following functions as desired here :

Code:
Option Explicit

Sub FiltrCols()
Dim lrow  As Long
Dim piece
Worksheets("Sheet2").Range("L2").AutoFilter _
    Field:=2, _
    Criteria1:=">" & "14"
Application.ScreenUpdating = False
    Dim Sorce, Targt As Worksheet
    
    
    Sheets("Sheet3").UsedRange.Delete
    
    '##delete old chart (if exists) from sheet
    If Sheets("Sheet3").ChartObjects.Count > 0 Then
        Sheets("Sheet3").ChartObjects(1).Delete
    End If

lrow = Range("L16").End(xlUp).Row
    For Each piece In Array("L2:L16", "M2:M16")
         Range(piece).Copy
        
        With Sheet3.Range(piece).Offset(0, -11)
            .PasteSpecial
            .PasteSpecial xlPasteValues
        End With
        
    Next
    
Sheet3.Rows(1).EntireRow.Delete

Create_Chart_Variable_Rows_NEW

Application.CutCopyMode = False

Sheets("Sheet3").Activate

    
    Sheets("Sheet3").Range("A1").Select
    
    
    
    
   
    
    Range("A1").Select
    Application.CutCopyMode = False
    
    Sheets("Sheet2").Activate
    Range("A1").Select
    
     On Error Resume Next
    
    Cells.AutoFilter
    Application.ScreenUpdating = True
    
    MsgBox "Done !"
 
End Sub

Sub Create_Chart_Variable_Rows_NEW()

'

On Error Resume Next

     Dim ws As Worksheet
     Set ws = Sheets("Sheet3")
     Dim rng As Range
     Dim objChrt As ChartObject
     Dim chrt As Chart
'

Dim r As Long
   r = ws.Cells(Rows.Count, "A").End(xlUp).Row

'

     With ws

        Set rng = .Range("A1:A" & r & ",B1:B" & r)

         .Shapes.AddChart
         Set objChrt = .ChartObjects(.ChartObjects.Count)
         Set chrt = objChrt.Chart

         With chrt
             .ChartType = xlColumnClustered
             .SetSourceData Source:=rng
         End With
     End With

End Sub
Also there were a few errors in formatting the DATE columns data. I ran the data through the ERROR CHECKING and updated to the correct format.
Attached Files
File Type: xlsm msofficeforums52909 01 (1).xlsm (35.7 KB, 3 views)
Reply With Quote