Can someone help? (urgently needed)

[rainx]

Hi, I have a problem here, I have a list of entries of which has different group names. I need to sort them into various files based on their group name. In a way, doing filter, However, my concern is my group names will vary every month and I also need the files to be save respectively at a place with their group name. Kinda tough, Hope someone would be able to provide some advice. Wondering if it can just filter those that are in the list into different files instead of providing a fixed list to do for all each time. Please Help!

Thanks!
<!-- / message --> <!-- sig --> __________________
Cheers
Rainx

 

[rainx]

No actually it do save as different workbook at C drive i duno why.. but then all the workbook contains all the different sheets. I only need 1 sheet for 1 workbook. Yup.. Dunno why?

 

[cornflakegirl]

Hmm... teach me to skim read threads - you'll find you now have multiple copies of the workbook - you may want to go and delete them... sorry! (Just my revenge really )

Will have another search and come back.

Edit - xpost!

 

[rainx]

huh?? Blur*

 

[cornflakegirl]

Okay - new code. Only slightly tweaked, but there are a couple of new variables, so posting the whole lot.

Sub FilterMacroToNewBooks()
Dim ws As Worksheet
Dim wb As Workbook
Dim rCellCounter As Range
Dim sDataSheet As String, sPath As String, sCurrencyField As String, sFilename As String
Dim iCurrencyColumn As Integer
sDataSheet = "Data" 'change this to the name of your sheet holding the original data
sCurrencyField = "Currency" 'change this to the title of your currency field
iCurrencyColumn = 1 'change this to the column number of your currency column
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
sPath = ActiveWorkbook.Path
'Delete any existing currency sheets
Application.DisplayAlerts = False
For Each ws In Worksheets
    If ws.Name <> sDataSheet Then ws.Delete
Next ws
Application.DisplayAlerts = True
'Create currency sheets
Set ws = Sheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = "Temp"
Sheets(sDataSheet).Columns(iCurrencyColumn).AdvancedFilter Action:=xlFilterCopy, _
    criteriarange:="", copyToRange:=Sheets("Temp").Range("A1"), Unique:=True
'must include criteriarange - advanced filter "remembers" the last settings
'Filter on to each sheet
For Each rCellCounter In Sheets("Temp").Range("A1").CurrentRegion
    If rCellCounter.Value <> sCurrencyField Then
        Set ws = Sheets.Add(After:=Worksheets(Worksheets.Count))
        ws.Name = rCellCounter.Value
        ws.Range("a1").Value = sCurrencyField
        ws.Range("a2").Value = rCellCounter.Value
        Sheets(sDataSheet).Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
            criteriarange:=ws.Range("A1:A2"), copyToRange:=ws.Range("A4"), Unique:=False
        ws.Rows("1:3").Delete
    End If
Next rCellCounter
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
For Each ws In Worksheets
    If ws.Name <> sDataSheet Then
        sFilename = ws.Name
        ws.Move
        ActiveWorkbook.SaveAs sPath & "\" & sFilename & ".xls"
    End If
Next ws
wb.Sheets(sDataSheet).Activate 'just for aesthetics
Application.ScreenUpdating = True
End Sub

 

[cornflakegirl]

(Luke - if you feel the need to boost your already ridiculously high post count, how about contributing something useful! )

 

[rainx]

HUH? High post count? i am getting more blur...

 

[cornflakegirl]

that was aimed at lasw10, not you

 

[rainx]

Anyway the new code works well! Thanks alot! Really..

But where izzit that I can change the place it is save? cos it is currently save to my C drive.

 

[cornflakegirl]

rainx - word of warning - this code has no error handling in it - might be worth adding some in case a file already exists with the same name as one you try to save.

 

[cornflakegirl]

sPath = ActiveWorkbook.Path

Change this to wherever you want to save it - excluding the final \ and the filename, because that's done lower down.