Filter, Count, Copy, Color based on progress-CodePudding

Apply a filter, Count based on a value, copy to another sheet, then color the cell based on how progress goes

I am working on an excel sheet, this sheet contains a list of drawings for a building, which contains 24 floors, each floor has a set of drawings that differs from other floors, which contains of course many systems, well I will concentrate here on the Electrical part.

drawings lists reside in column #3 (C- Column), 1st approval code reside in column #12 (column L), second approval code resides in Column #18 (Column R) and third approval code reside in column #24 (column X). on the next sheet, there is a table, shows the floors along with the number of associated drawings which belong to it. on the next sheet also, there is a schematic showing the distribution of the floors and how they will look like at the end.

The Needed: I need a micro, doing the filtration first based on floor number, and count how many drawings for that floor which has a code B (from different approval columns mentioned above) and paste it (the sum) into next sheet under (Approved DWG's)

2- fill the cells enter image description here associated with the floor with green as progress goes, I mean if for example basement 04 has 90 drawings, 80% were approved, cells will coloured with green until all those 90 drawings completed with code B

CodePudding user response：

THIS is what i want to be done for all floors. but I made this for Basement4,

Sub TEST()

ActiveSheet.Range("$A$1:$AK$2269").AutoFilter Field:=5, Criteria1:="=5", _
    Operator:=xlOr, Criteria2:="=B04"
ActiveWindow.SmallScroll Down:=-30
ActiveWindow.ScrollRow = 306
ActiveWindow.LargeScroll Down:=-1
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 333
ActiveWindow.ScrollRow = 603
ActiveWindow.ScrollRow = 686
ActiveWindow.ScrollRow = 1432
ActiveWindow.ScrollRow = 1268
ActiveWindow.ScrollRow = 315
ActiveWindow.ScrollRow = 259
ActiveWindow.SmallScroll Down:=45
Range("R1127:R1133").Select
ActiveWindow.SmallScroll Down:=12
Range("R1467:R1473").Select
ActiveWindow.SmallScroll Down:=15
Range("L1793:L1952").Select
ActiveWindow.SmallScroll Down:=15
Sheets("Completion_Graph").Select
Range("D41").Select
ActiveCell.FormulaR1C1 = "32"
Range("F41").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-3]"
Range("G38:M38").Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 5287936
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
End Sub

CodePudding user response：

because I was not able to share the workbook please visit below link

https://www.mrexcel.com/board/threads/copy-from-differents-sheets-and-update-the-master-sheet-within-the-same-workbook-with-colouring-cells-convert-all-sheets-to-pdf-and-email.1190804/