J G
asked on
filter a excel docuement using VBA and export results
I want to filter a excel doc, and save the results in a new .xlsx (same directory) with the current filename_filtervalue.xlsx
I.E. current filename is "new", and I am filtering in column C with the text "grass", I want the macro to save the file as: "new_grass.xlsx" in the same directory as the active workbook.
1) the parameters that I will be filtering will change every time, so I want the VBA to look at "first choice" to filter, then save, look at the "second choice" to filter than save, look at the "third choice" to filter then save etc.
2) I think the vba can reference what is in cell C1 after the filter is applied to know what filter value to add to the filename.
3) FYI I am using the following code to create the initial workbook that will be filtered. This workbook was originally a .csv that will be saved as current filename.xlsx after I run the first part of the macro.
'Function:
Public Function s_as(xlsx As String) As String
s_as = ActiveWorkbook.FullName
s_as = Left(s_as, InStrRev(s_as, ".")) & xlsx
End Function
'USAGE:
ActiveWorkbook.SaveAs FileName:=s_as("xlsx"), FileFormat:=xlOpenXMLWorkb
4) I will not need code examples of how to cut and paste the results in the new .xlsx,
just help with the filtering, and the save as of the new file.
5) IF you could give me the sub proceedure code/function code as well as the usage code (how it will be called out from another module) that would be greatly appreciated.
thanks
I.E. current filename is "new", and I am filtering in column C with the text "grass", I want the macro to save the file as: "new_grass.xlsx" in the same directory as the active workbook.
1) the parameters that I will be filtering will change every time, so I want the VBA to look at "first choice" to filter, then save, look at the "second choice" to filter than save, look at the "third choice" to filter then save etc.
2) I think the vba can reference what is in cell C1 after the filter is applied to know what filter value to add to the filename.
3) FYI I am using the following code to create the initial workbook that will be filtered. This workbook was originally a .csv that will be saved as current filename.xlsx after I run the first part of the macro.
'Function:
Public Function s_as(xlsx As String) As String
s_as = ActiveWorkbook.FullName
s_as = Left(s_as, InStrRev(s_as, ".")) & xlsx
End Function
'USAGE:
ActiveWorkbook.SaveAs FileName:=s_as("xlsx"), FileFormat:=xlOpenXMLWorkb
4) I will not need code examples of how to cut and paste the results in the new .xlsx,
just help with the filtering, and the save as of the new file.
5) IF you could give me the sub proceedure code/function code as well as the usage code (how it will be called out from another module) that would be greatly appreciated.
thanks
What's the filter criteria?
ASKER
can I program the vba to select the "next" available filter criterea?
it will be a list of categories like "taxable" "produce" etc. Up to 35 categories, amount could change every time.
it will be a list of categories like "taxable" "produce" etc. Up to 35 categories, amount could change every time.
ASKER
Any expert out there with a solution to this question?
from what I understand you want to create a spate workbook based on the unique values of a single column.
is that correct?
is that correct?
if yes, then let me know. I have the code ready for you.
see the attached workbook example.
in this example it is assumed that the column which you want to filter and have each file separately created for each individual unique company. run the macro called "splitCompany" then follow along
F--Split-Data-Based-on-Column-Value.xls
in this example it is assumed that the column which you want to filter and have each file separately created for each individual unique company. run the macro called "splitCompany" then follow along
F--Split-Data-Based-on-Column-Value.xls
ASKER
yes
I've requested that this question be deleted for the following reason:
Not enough information to confirm an answer.
Not enough information to confirm an answer.
MartinLiss
i object to this closure "Not enough information"
I have spent time, creating the file and the solution which is exactly what the asker tike55 have requested. if he does not provide feedback, it shouldn't be at the cost of my time.
I recommend that the question will be closed by acceptance of the post ID: 40353400
i object to this closure "Not enough information"
I have spent time, creating the file and the solution which is exactly what the asker tike55 have requested. if he does not provide feedback, it shouldn't be at the cost of my time.
I recommend that the question will be closed by acceptance of the post ID: 40353400
ASKER
Please Do not close!
I have been busy, working on this project again
I have been busy, working on this project again
tike55
see my post ProfessorJimJam2014-09-30 at 23:31:07ID: 40353400
that is the solution. please let me know.
see my post ProfessorJimJam2014-09-30 at 23:31:07ID: 40353400
that is the solution. please let me know.
ASKER
Hi Professor!
that is awesome. This is sooo much help!
I ran the macro, could you help me with a few adjustments & one question:
1) could you make the macro compatible with 64 bit systems? I am getting an error
2) could you take away prompt at the end "do you want to save as workbooks" and just have have them save out as workbooks in the same directory, as well as having the master workbook saved?
3) could you take away the completed in 2 millisecond prompt
4) could you just have it always filter on column L
1) Will this macro work with any workbook? or does it have to have a certain column layout?
that is awesome. This is sooo much help!
I ran the macro, could you help me with a few adjustments & one question:
1) could you make the macro compatible with 64 bit systems? I am getting an error
2) could you take away prompt at the end "do you want to save as workbooks" and just have have them save out as workbooks in the same directory, as well as having the master workbook saved?
3) could you take away the completed in 2 millisecond prompt
4) could you just have it always filter on column L
1) Will this macro work with any workbook? or does it have to have a certain column layout?
ASKER
HI Professor,
the main fix would be to make it compatible with 64 bit systems
if you could help me with the other adjustments that would be great. Once I hear back from you I will close the question. Sorry it took so long to get back.
the main fix would be to make it compatible with 64 bit systems
if you could help me with the other adjustments that would be great. Once I hear back from you I will close the question. Sorry it took so long to get back.
Give me 2 hours I am away from my computer, as soon as I get home I will send u code
ASKER
Awsome! thanks man - If I could get all 5 issues above fixed the macro will be perfect!
here is the code
Sub SplitWorkbook()
Dim colLetter As String, SavePath As String
Dim lastValue As String
Dim wb As Workbook
Dim lng As Long
Dim currentRow As Long
Dim Fname As String, FFname As String
Fname = ThisWorkbook.Name
FFname = Left(Fname, InStr(Fname, ".") - 1)
Application.ScreenUpdating = False
colLetter = "L"
SavePath = ActiveWorkbook.path
'Sort the workbook.
With ActiveWorkbook.Worksheets(1)
.Sort.SortFields.Add Key:=.Range(colLetter & ":" & colLetter), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange .Parent.UsedRange.Cells
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For lng = 2 To .Range(colLetter & .Rows.Count).End(xlUp).Row
If .Cells(lng, colLetter).Value = "" Then Exit For
lastValue = .Cells(lng, colLetter).Value
.Cells.AutoFilter field:=.Cells(lng, colLetter).Column, Criteria1:=lastValue
lng = .Cells(.Rows.Count, colLetter).End(xlUp).Row
Set wb = Application.Workbooks.Add(xlWorksheet)
wb.Sheets(1).Name = "Split"
.Rows(1 & ":" & lng).Copy wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp)
wb.SaveAs SavePath & "\" & FFname & " " & Replace(lastValue, ".", " "), 52
wb.Close
Next
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End SubASKER
thanks,
I will try it and let you know asap how it works. Should I just drop the code in a new module?
I will try it and let you know asap how it works. Should I just drop the code in a new module?
yes
put it in a new module on the workbook the one which you want to split its data based on column L
it will not give you any prompt. it will save all workbooks in the same folder as the original workbook.
put it in a new module on the workbook the one which you want to split its data based on column L
it will not give you any prompt. it will save all workbooks in the same folder as the original workbook.
ASKER
this is close!
1) I am storing the macro in a personal.xlsm workbook. It is saving a extra copy of this workbook in the directory as xlsx as well as a xlsx of the active workbook. could it just be the active workbook.
2) the code is not saving out the filtered results in new xlsx files
3) could the worksheet tabs that it creates before the export be preserved and saved in the initial xlsx file. So, the final result would be:
original csv (preserved and closed)
original xlsx (saved with filtered tabs)
exported xlsx workbooks (based upon filter results)
thanks I super appreciate your help!
1) I am storing the macro in a personal.xlsm workbook. It is saving a extra copy of this workbook in the directory as xlsx as well as a xlsx of the active workbook. could it just be the active workbook.
2) the code is not saving out the filtered results in new xlsx files
3) could the worksheet tabs that it creates before the export be preserved and saved in the initial xlsx file. So, the final result would be:
original csv (preserved and closed)
original xlsx (saved with filtered tabs)
exported xlsx workbooks (based upon filter results)
thanks I super appreciate your help!
try this one
Sub SplitWorkbooks()
Dim LastRow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet, r As Range, iCol As Integer, t As Date, Prefix As String
Dim sh As Worksheet, Master As String
On Error Resume Next
Set r = Range("A:A")
On Error GoTo 0
If r Is Nothing Then Exit Sub
iCol = r.Column
t = Now
Application.ScreenUpdating = False
With ActiveSheet
Master = .Name
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), Cells(LastRow, LastCol)).Sort Key1:=Cells(2, iCol), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iStart = 2
For i = 2 To LastRow
If .Cells(i, iCol).Value <> .Cells(i + 1, iCol).Value Then
iEnd = i
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
On Error Resume Next
ws.Name = .Cells(iStart, iCol).Value
On Error GoTo 0
ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
.Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
iStart = iEnd + 1
End If
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> Master Then
sh.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.path & "\" & sh.Name & ".xlsx"
ActiveWorkbook.Close
End If
Next sh
Application.ScreenUpdating = True
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
i forgot to change the column now it is changed to column L and took care of the new grass prefix
Sub SplitWorkbooks()
Dim LastRow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet, r As Range, iCol As Integer, t As Date, Prefix As String
Dim sh As Worksheet, Master As String
On Error Resume Next
Set r = Range("L:L")
On Error GoTo 0
If r Is Nothing Then Exit Sub
iCol = r.Column
t = Now
Application.ScreenUpdating = False
With ActiveSheet
Master = .Name
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), Cells(LastRow, LastCol)).Sort Key1:=Cells(2, iCol), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iStart = 2
For i = 2 To LastRow
If .Cells(i, iCol).Value <> .Cells(i + 1, iCol).Value Then
iEnd = i
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
On Error Resume Next
ws.Name = .Cells(iStart, iCol).Value
On Error GoTo 0
ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
.Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
iStart = iEnd + 1
End If
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Prefix = "new_grass"
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> Master Then
sh.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.path & "\" & Prefix & sh.Name & ".xlsx"
ActiveWorkbook.Close
End If
Next sh
Application.ScreenUpdating = True
ThisWorkbook.Save
ThisWorkbook.Close
End SubASKER
SOOO CLOSE!
All that needs to happen is:
1) original csv (should be: preserved and closed)- original file not being preserved and closing, tabs are also being added to this worksheet instead of original xlsx
2) original xlsx (should be: saved with filtered tabs, left open and saved) - not being created or saved
3) exported xlsx workbooks (based upon filter results) - it created a 1 blank excel worksheet called sheet 1. (should be: 1 xlsx file per each filter result). All of these files should be saved and closed with the following naming scheme: I.E. current filename is "new", and I am filtering in column C with the text "grass", I want the macro to save the file as: "new_grass.xlsx" in the same directory as the active workbook.
thanks!
All that needs to happen is:
1) original csv (should be: preserved and closed)- original file not being preserved and closing, tabs are also being added to this worksheet instead of original xlsx
2) original xlsx (should be: saved with filtered tabs, left open and saved) - not being created or saved
3) exported xlsx workbooks (based upon filter results) - it created a 1 blank excel worksheet called sheet 1. (should be: 1 xlsx file per each filter result). All of these files should be saved and closed with the following naming scheme: I.E. current filename is "new", and I am filtering in column C with the text "grass", I want the macro to save the file as: "new_grass.xlsx" in the same directory as the active workbook.
thanks!
i am lost, i am not sure what is required further. i have changed the macro many times.
ASKER
sorry man! I really appreciate your help, can we try 1 more revision? Please bare with me, we are soo close!
Hopefully my comments below will clarify.
objective:
original csv (preserved and closed)
original xlsx (created, saved in same directory, and left open with filtered tabs)
exported xlsx workbooks (created, saved in same directory and closed)
remaining issues:
1) original csv - right now the original file (active workbook) is not being preserved and closing. Tabs are also being added to this worksheet instead of a new original xlsx file. Could this csv file be preserved and closed?
2) original xlsx - right now this is not being created or saved. Could this xlsx be created, saved in the same directory as original.csv, and left open with filtered tabs.
3) exported xlsx workbooks - right now the macro just creates 1 blank excel worksheet called sheet 1. Could the macro create 1 xlsx file per each filter result, saved and closed in the same directory as original.csv.
Hopefully my comments below will clarify.
objective:
original csv (preserved and closed)
original xlsx (created, saved in same directory, and left open with filtered tabs)
exported xlsx workbooks (created, saved in same directory and closed)
remaining issues:
1) original csv - right now the original file (active workbook) is not being preserved and closing. Tabs are also being added to this worksheet instead of a new original xlsx file. Could this csv file be preserved and closed?
2) original xlsx - right now this is not being created or saved. Could this xlsx be created, saved in the same directory as original.csv, and left open with filtered tabs.
3) exported xlsx workbooks - right now the macro just creates 1 blank excel worksheet called sheet 1. Could the macro create 1 xlsx file per each filter result, saved and closed in the same directory as original.csv.
ASKER
I cannot tell you how much I appreciate your help!!!!
Ok, then i will try for the last time.
please answer the following question
1) original csv should this file be affected at all? is this the source file based on which from its data the new sheets are created and saved in separate files? once the workbooks created you want the csv to be saved with having multiple tabs(sheets) in it? and then saved and closed? if yes: then sorry the CSV format file cannot support having multiple sheets in its workbook. then is not possible at all.
2) original xlsx what is this file? is this cvs file in form of xlsx? do you want the tabs created and saved in xlsx format?
3) exported xlsx This part should not have any problem. please tell me what is the column number/Name based on which the data needs to split. you told me it is column L and the latest code i posted, considers column L having data. i assume when you run the code your column L did not have data in it. please confirm the column.
please answer the following question
1) original csv should this file be affected at all? is this the source file based on which from its data the new sheets are created and saved in separate files? once the workbooks created you want the csv to be saved with having multiple tabs(sheets) in it? and then saved and closed? if yes: then sorry the CSV format file cannot support having multiple sheets in its workbook. then is not possible at all.
2) original xlsx what is this file? is this cvs file in form of xlsx? do you want the tabs created and saved in xlsx format?
3) exported xlsx This part should not have any problem. please tell me what is the column number/Name based on which the data needs to split. you told me it is column L and the latest code i posted, considers column L having data. i assume when you run the code your column L did not have data in it. please confirm the column.
ASKER
1) original csv should not be affected. It is just the source file. no tabs. Just copy to make original.xlsx. After the macro runs, close this file.
2)original.xlsx is a file created from original.csv. I want tabs created in this file. Please filter on column D
(do not use column L- was my bad) After the macro runs, save and leave this file open.
3) create 1 export.xlsx for each of the filtered tabs above. After the macro runs, these files should be saved and closed.
2)original.xlsx is a file created from original.csv. I want tabs created in this file. Please filter on column D
(do not use column L- was my bad) After the macro runs, save and leave this file open.
3) create 1 export.xlsx for each of the filtered tabs above. After the macro runs, these files should be saved and closed.
ASKER
hopefully that helps!
the only question i have is where are you going to place the macro module? because in CVS cannot hold any module. will you be running this from Personal.xlsb?
ASKER
it will be in my personal.xls file. So all of the actions should be preformed on the active worksheet (csv) .
ASKER
personal.xlsm file
ok. give me sometime, as i am not close to my PC. i will get you a possible solution as soon as i can.
ASKER
Also worth noting,
1) all files should be created in same directory as original.csv
2) the file names of the csv's will always be different, I am using "original" for the purposes of explaning the macro to you.
3) All of the exported files should be saved and closed with the following naming scheme: I.E. original.xlsx filename is "new.xlsx". First tab is named "grass" (based upon filter results), I want the macro to save the exported file as: "new_grass.xlsx" in the same directory as the active workbook. Second tab is named "water" (based upon filter results), I want the macro to save the exported file as : "new_water.xlsx" in the same directory as the active workbook (etc).
1) all files should be created in same directory as original.csv
2) the file names of the csv's will always be different, I am using "original" for the purposes of explaning the macro to you.
3) All of the exported files should be saved and closed with the following naming scheme: I.E. original.xlsx filename is "new.xlsx". First tab is named "grass" (based upon filter results), I want the macro to save the exported file as: "new_grass.xlsx" in the same directory as the active workbook. Second tab is named "water" (based upon filter results), I want the macro to save the exported file as : "new_water.xlsx" in the same directory as the active workbook (etc).
ASKER
Last note:
only workbook that should be open after the macro runs should be original.xlsx. Keep it open on the first tab, with no cells selected.
thank you thank you thank you!
only workbook that should be open after the macro runs should be original.xlsx. Keep it open on the first tab, with no cells selected.
thank you thank you thank you!
Here you go
put this code into a module of your Personal.xlsm and then when opened your csv file RUN the macro called "SPLITMACRO" and then it will do exactly as you requested.
let me know.
put this code into a module of your Personal.xlsm and then when opened your csv file RUN the macro called "SPLITMACRO" and then it will do exactly as you requested.
let me know.
Sub SPLITMACRO()
' 11/4/2014 by ProfessorJimJam Solution to question number Q28526576
Dim colLetter As String, SavePath As String
Dim lastValue As String
Dim wb As Workbook
Dim lng As Long
Dim currentRow As Long
Dim FN As String, FF As String
colLetter = "D"
SavePath = "" 'Indicate the path to save
If SavePath = "" Then SavePath = ActiveWorkbook.Path
'Sort the workbook.
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets(1)
.Sort.SortFields.Add Key:=.Range(colLetter & ":" & colLetter), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange .Parent.UsedRange.Cells
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For lng = 2 To .Range(colLetter & .Rows.Count).End(xlUp).Row
If .Cells(lng, colLetter).Value = "" Then Exit For
lastValue = .Cells(lng, colLetter).Value
.Cells.AutoFilter field:=.Cells(lng, colLetter).Column, Criteria1:=lastValue
lng = .Cells(.Rows.Count, colLetter).End(xlUp).Row
Set wb = Application.Workbooks.Add(xlWorksheet)
wb.Sheets(1).Name = lastValue
.Rows(1 & ":" & lng).Copy wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp)
wb.SaveAs SavePath & "\" & "new_grass" & " " & Replace(lastValue, ".", " "), 51
wb.Close
Next
.AutoFilterMode = False
End With
Call SplitSheets
Call Filteron
FN = ActiveWorkbook.FullName
FF = Left(FN, Len(FN) - 3)
ActiveWorkbook.SaveAs Filename:=FF & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.ScreenUpdating = True
End Sub
Private Sub SplitSheets()
Dim LastRow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet, r As Range, iCol As Integer, t As Date, Prefix As String
Dim sh As Worksheet, Master As String
On Error Resume Next
Set r = Range("D:D")
On Error GoTo 0
If r Is Nothing Then Exit Sub
iCol = r.Column
t = Now
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets(1)
Master = .Name
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), Cells(LastRow, LastCol)).Sort Key1:=Cells(2, iCol), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iStart = 2
For i = 2 To LastRow
If .Cells(i, iCol).Value <> .Cells(i + 1, iCol).Value Then
iEnd = i
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
On Error Resume Next
ws.Name = .Cells(iStart, iCol).Value
On Error GoTo 0
ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
.Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
iStart = iEnd + 1
End If
Next i
End With
End Sub
Private Sub Filteron()
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Range("A1").Activate
Selection.AutoFilter
Next ws
Application.ScreenUpdating = True
End SubASKER
thank you ! I will try today and let you know how it works
it will surely work. as i tested it before posting it here. ;-)
ASKER
AWSOME!!!!! You are sooo awesome!
1 adjustment:
the macro is not creating new separate xlsx worksheets based upon the filter results on each tab. See 40413965
So could you keep the macro as is, and just ad this functionality at the end?
1 adjustment:
the macro is not creating new separate xlsx worksheets based upon the filter results on each tab. See 40413965
So could you keep the macro as is, and just ad this functionality at the end?
ASKER
So to be clear, the macro is working as requested except for the last part.
If each tab can be exported out to its on individual worksheet in the same directory that would be fantastic.
use the following naming scheme ( I.E. original.xlsx filename is "new.xlsx". First tab is named "grass" (based upon filter results), I want the macro to save the exported file as: "new_grass.xlsx" in the same directory as the active workbook. Second tab is named "water" (based upon filter results), I want the macro to save the exported file as : "new_water.xlsx" in the same directory as the active workbook (etc).
If each tab can be exported out to its on individual worksheet in the same directory that would be fantastic.
use the following naming scheme ( I.E. original.xlsx filename is "new.xlsx". First tab is named "grass" (based upon filter results), I want the macro to save the exported file as: "new_grass.xlsx" in the same directory as the active workbook. Second tab is named "water" (based upon filter results), I want the macro to save the exported file as : "new_water.xlsx" in the same directory as the active workbook (etc).
look, you must have done something, there the macro works. check your column is it D? Column D?
the macro does the following
A) creates indivitual workbooks in the same directory as where the csv file is located, for each unique filtered values as per column D the files are saved as xlsx with prefix of Grass_UnqiueValuename and then it also creates new workbook with normal file extention of xlsx that has multiple sheets each sheet for each unique value based on column D. then it also saves the new created file that has many worksheets in the same directory where the csv file is. the file name is also the same as csv , except that it is in a xlsx ext.
i do not understand what part is not working. do you want the new file to be named "original"? instead of having the same name as csv name?
the macro does the following
A) creates indivitual workbooks in the same directory as where the csv file is located, for each unique filtered values as per column D the files are saved as xlsx with prefix of Grass_UnqiueValuename and then it also creates new workbook with normal file extention of xlsx that has multiple sheets each sheet for each unique value based on column D. then it also saves the new created file that has many worksheets in the same directory where the csv file is. the file name is also the same as csv , except that it is in a xlsx ext.
i do not understand what part is not working. do you want the new file to be named "original"? instead of having the same name as csv name?
see the modified code below, creates the original.xlsx as well. all of the created files are in the same directory folder where the csv is located.
the seperate files created will have a prefix of "new" and the the tab name saved in the same directory as the csv file
the seperate files created will have a prefix of "new" and the the tab name saved in the same directory as the csv file
Sub SPLITMACRO()
' 11/4/2014 by ProfessorJimJam Solution to question number Q28526576
Dim colLetter As String, SavePath As String
Dim lastValue As String
Dim wb As Workbook
Dim lng As Long
Dim currentRow As Long
Dim FN As String, FF As String
colLetter = "D"
SavePath = "" 'Indicate the path to save
If SavePath = "" Then SavePath = ActiveWorkbook.path
'Sort the workbook.
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets(1)
.Sort.SortFields.Add Key:=.Range(colLetter & ":" & colLetter), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange .Parent.UsedRange.Cells
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For lng = 2 To .Range(colLetter & .Rows.Count).End(xlUp).Row
If .Cells(lng, colLetter).Value = "" Then Exit For
lastValue = .Cells(lng, colLetter).Value
.Cells.AutoFilter field:=.Cells(lng, colLetter).Column, Criteria1:=lastValue
lng = .Cells(.Rows.Count, colLetter).End(xlUp).Row
Set wb = Application.Workbooks.Add(xlWorksheet)
wb.Sheets(1).Name = lastValue
.Rows(1 & ":" & lng).Copy wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp)
wb.SaveAs SavePath & "\" & "New" & " " & Replace(lastValue, ".", " "), 51
wb.Close
Next
.AutoFilterMode = False
End With
Call SplitSheets
Call Filteron
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.path & "\" & "original", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.ScreenUpdating = True
End Sub
Private Sub SplitSheets()
Dim LastRow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet, r As Range, iCol As Integer, t As Date, Prefix As String
Dim sh As Worksheet, Master As String
On Error Resume Next
Set r = Range("D:D")
On Error GoTo 0
If r Is Nothing Then Exit Sub
iCol = r.Column
t = Now
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets(1)
Master = .Name
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), Cells(LastRow, LastCol)).Sort Key1:=Cells(2, iCol), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iStart = 2
For i = 2 To LastRow
If .Cells(i, iCol).Value <> .Cells(i + 1, iCol).Value Then
iEnd = i
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
On Error Resume Next
ws.Name = .Cells(iStart, iCol).Value
On Error GoTo 0
ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
.Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
iStart = iEnd + 1
End If
Next i
End With
End Sub
Private Sub Filteron()
Dim ws As Worksheet
Application.ScreenUpdating = False
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Range("A1").Activate
Selection.AutoFilter
Next ws
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
please check and let me know. this issue really been dragged for long. i want to close this chapter asap.
ASKER
HI Professor,
I just realized the code in ID: 40422921 works with one exception:
In order to articulate my idea correctly I have attached a csv example to be more clear, and save you any more headaches and time!
attached is exampl1 9.9.14.csv
after the macro is run there should be the following spreadsheets:
1) exampl1 9.9.14.csv (closed and saved)
2) exampl1 9.9.14.xlsx (saved in same directory and still open on first tab) (this workbook should have 3 worksheets based upon filter results named: hiking supply, socks, bars)
3) exampl1 9.9.14_hiking supply.xlsx (closed and saved in the same directory)
exampl1 9.9.14_socks.xlsx (closed and saved in the same directory)
exampl1 9.9.14_bars.xlsx (closed and saved in the same directory)
example1-9.9.14.xlsx
I just realized the code in ID: 40422921 works with one exception:
In order to articulate my idea correctly I have attached a csv example to be more clear, and save you any more headaches and time!
attached is exampl1 9.9.14.csv
after the macro is run there should be the following spreadsheets:
1) exampl1 9.9.14.csv (closed and saved)
2) exampl1 9.9.14.xlsx (saved in same directory and still open on first tab) (this workbook should have 3 worksheets based upon filter results named: hiking supply, socks, bars)
3) exampl1 9.9.14_hiking supply.xlsx (closed and saved in the same directory)
exampl1 9.9.14_socks.xlsx (closed and saved in the same directory)
exampl1 9.9.14_bars.xlsx (closed and saved in the same directory)
example1-9.9.14.xlsx
ASKER
Hopefully my last post will be helpful and expedite the development. Believe me I want to put this to rest ASAP..
I super apprecieate your help!!!
I super apprecieate your help!!!
ASKER
keep in mind the csv will be named different everytime, so the corresponding spreadsheets should be variable as well
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Awsome Expert worthy of MVP