Hi, rishikrsaw,
both procedures go into the same Standard Module:
Private Sub FindUniqueItems(UniqueItems As Variant, FilterRange As String)
' basic: ERLANDSEN DATA CONSULTING, http://www.erlandsendata.no/downloads/filterandprint.zip
' returns a list containing all unique items in the filter range
Dim TempList() As String, UniqueCount As Integer, cl As Range, i As Integer
Range(FilterRange).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
UniqueCount = Range(FilterRange).SpecialCells(xlCellTypeVisible).Count
ReDim TempList(1 To UniqueCount - 1)
i = 0
For Each cl In Range(FilterRange).SpecialCells(xlCellTypeVisible)
i = i + 1
If i > 1 Then TempList(i - 1) = cl.Formula ' ignore the heading
Next cl
Set cl = Nothing
UniqueItems = TempList
With ActiveSheet
.ShowAllData
End With
End Sub
Sub EF1023881()
Dim ItemList As Variant
Dim lngC As Long
Dim lngLastRow As Long
Dim ws As Worksheet
Dim rngCur As Range
Dim rngCopy As Range
Dim FileExtStr As String
Dim FileFormatNum As String
Select Case ThisWorkbook.FileFormat
Case 51
FileExtStr = ".xlsx"
FileFormatNum = 51
Case 52:
If ThisWorkbook.HasVBProject Then
FileExtStr = ".xlsm"
FileFormatNum = 52
Else
FileExtStr = ".xlsx"
FileFormatNum = 51
End If
Case 56
FileExtStr = ".xls"
FileFormatNum = 56
Case Else
FileExtStr = ".xlsb"
FileFormatNum = 50
End Select
Set ws = Workbooks("Book2.xlsx").Sheets("Master")
lngLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
FindUniqueItems ItemList, Range("A1:A" & lngLastRow).Address
Set rngCur = ws.Range("A1").CurrentRegion
Set ws = Nothing
For lngC = 1 To UBound(ItemList)
rngCur.AutoFilter _
field:=1, _
Criteria1:=ItemList(lngC)
Set rngCopy = rngCur.SpecialCells(xlCellTypeVisible)
Workbooks.Add xlWBATWorksheet
rngCopy.Copy Range("A1")
ActiveSheet.Name = ItemList(lngC)
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & ItemList(lngC) & FileExtStr, FileFormatNum
ActiveWorkbook.Close False
Next lngC
rngCur.AutoFilter
Set rngCopy = Nothing
Set rngCur = Nothing
End Sub
This will take the path where to save the workbooks from the workbook with the code as well as when trying to make up what extension to use for the new workbooks.
How to install your new code
- Copy the Excel VBA code
- Select the workbook in which you want to store the Excel VBA code
- Press Alt+F11 to open the Visual Basic Editor
- Choose Insert > Module
- Edit > Paste the macro into the module that appeared
- Close the VBEditor
- Save your workbook (Excel 2007+ select a macro-enabled file format, like *.xlsm)
To run the Excel VBA code:- Press Alt-F8 to open the macro list
- Select a macro in the list
- Click the Run button
Ciao,
Holger
Bookmarks