Sub ValuesToGraph() Dim i As Variant, j As Variant Dim ws As Worksheet: Set ws = Sheets("Completed") Dim ws1 As Worksheet: Set ws1 = Sheets("Monthly Graph Completed") Dim lr As Long: lr = ws.Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False ws.Range("F2:F" & lr).Copy ws.[X2] '---->Extract the "Due Date" column(F)over to Column X. ws.Range("X2", ws.Range("X" & ws.Rows.Count).End(xlUp)).Sort ws.[X2], 1 '---->Sort in month order (Jan-Dec). ws.Range("Y2:Y" & lr) = "=TEXT(X2,""MMMM"")" '---->Extract the month names from Column X to Column Y. ws.Range("AA2:AA13") = "=COUNTIF(Y:Y,Z2)" '---->Counts the number of month entries. 'The following extracts the unique month names into Column Z so that duplicates are not included. j = Application.Transpose(ws.Range("Y2", ws.Range("Y" & ws.Rows.Count).End(xlUp))) With CreateObject("Scripting.Dictionary") For Each i In j .Item(i) = i Next ws.Cells(2, 26).Resize(.Count) = Application.Transpose(.Keys) '---->Unique month names are placed in Column Z starting in row2. End With ws1.Range("B2:B13").Value = ws.Range("AA2:AA13").Value '---->The month quantities are placed in Column B of the graph sheet. ws.Columns("X:AA").Clear '---->The helper columns are cleared. Application.ScreenUpdating = True End Sub
Sub ValuesToGraph() Dim i As Variant, j As Variant, c As Range Dim ws As Worksheet: Set ws = Sheets("Completed") Dim ws1 As Worksheet: Set ws1 = Sheets("Monthly Graph Completed") Dim lr As Long: lr = ws.Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False ws.Range("F2:F" & lr).Copy ws.[X2] '---->Extract the "Due Date" column(F)over to Column X. ws.Range("Y2:Y" & lr) = "=TEXT(X2,""MMMM"")" '---->Extract the month names from Column X to Column Y. ws.Range("AA2:AA13") = "=COUNTIF(Y:Y,Z2)" '---->Counts the number of month entries. 'The following extracts the unique month names into Column Z so that duplicates are not included. j = Application.Transpose(ws.Range("Y2", ws.Range("Y" & ws.Rows.Count).End(xlUp))) With CreateObject("Scripting.Dictionary") For Each i In j .Item(i) = i Next ws.Cells(2, 26).Resize(.Count) = Application.Transpose(.Keys) '---->Unique month names are placed in Column Z starting in row2. End With 'Sending the correct values to B2:B13 of the Graph sheet regardless of the month order in the Completed sheet. For i = 2 To lr For Each c In ws1.Range("A2:A13") If c.Value = ws.Cells(i, 26).Value Then c.Offset(, 1).Value = ws.Cells(i, 27).Value End If Next c Next i ws.Columns("X:AA").Clear '---->The helper columns are cleared. Application.ScreenUpdating = True End Sub
DON'T MISS
Thank you,
Rylee