PDA

View Full Version : [SOLVED] Create table for each name in specific column



YasserKhalil
10-12-2017, 10:54 AM
Hello everyone
I have data in sheets("Data") and I need to create table for each name in column C and leave two empty rows in between ..
Also to put SUM formulas after each table

I have attached expected output so as to make it clearer ..
Thanks advanced for help

p45cal
10-12-2017, 12:10 PM
Click the button at cell J1 of the Data sheet in the attached.
Code is:
Sub blah()
Set SourceSht = Sheets("Data")
Set RngToFilter = SourceSht.Range("A1").CurrentRegion
Set NewSht = Sheets.Add(After:=Sheets(Sheets.Count))
Set Destn = NewSht.Range("A1")
Set dict = CreateObject("scripting.dictionary")
For Each cll In Intersect(RngToFilter.Columns(2), RngToFilter.Columns(2).Offset(1))
If Not cll.Value = Empty Then dict.Item(cll.Value) = cll.Value
Next cll
For Each ky In dict.keys
RngToFilter.AutoFilter Field:=2, Criteria1:=ky
RngToFilter.Copy Destn
RowCount = Destn.CurrentRegion.Rows.Count
Destn.Offset(RowCount, 4).Resize(, 4).FormulaR1C1 = "=SUM(R[-" & RowCount - 1 & "]C:R[-1]C)"
Set Destn = Destn.Offset(RowCount + 3)
Next ky
RngToFilter.AutoFilter
NewSht.Columns("A:I").EntireColumn.AutoFit
End Sub

YasserKhalil
10-12-2017, 12:24 PM
Thank you very much for this great and awesome solution
Best and kind regards