Niranjanrajrishi
Member
Hello,
Need help to create coding to generate excel workbooks based on column "D" and column "L". I have attached the excel sheet with the data.
For example, 1st excel file should be created for BA (column D) and Direct (column L), then BA and Indirect.
The attached coding will consider only one column value (advanced filter).
Your help would be mucha appreciated.
Need help to create coding to generate excel workbooks based on column "D" and column "L". I have attached the excel sheet with the data.
For example, 1st excel file should be created for BA (column D) and Direct (column L), then BA and Indirect.
The attached coding will consider only one column value (advanced filter).
Code:
Sub ListCreation()
Application.ScreenUpdating = False
On Error Resume Next
With Sheets("Data")
m_max = .Cells(.Rows.Count, 13).End(xlUp).Row
.Range("M1:M" & m_max).Clear
k_max = .Cells(.Rows.Count, 12).End(xlUp).Row
.Range("D1:D" & k_max).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("M1"), Unique:=True
m_max = .Cells(.Rows.Count, 13).End(xlUp).Row
For m = 2 To m_max
CRI = .Cells(m, 13)
chk = Evaluate("ISREF('" & CRI & "'!D1)")
If Not chk Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = CRI
.Range("A1:L" & k_max).AutoFilter
.Range("A1:L" & k_max).AutoFilter Field:=4, Criteria1:=CRI
.Range("A1:L" & k_max).Copy
With Sheets(CRI).Range("A1")
.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Select
Columns.AutoFit = True
ActiveWindow.DisplayGridlines = False
End With
Next m
.Select
.Range("A1:J" & k_max).AutoFilter
.Range("J1:J" & m_max).Clear
End With
Application.ScreenUpdating = True
End Sub