Export data to workbook with criteria with few selected columns

Hudson Andrew

New Member
Joined
Sep 28, 2016
Messages
27
Hi all,




I have code which exports data to workbook ( to folder specified in control sheet) code is so far so good the only challenge is i do not want every other roww rather i only few specified row to be exported . out of below 9 colums i only need 5 columns.


Sales Representative Location Region Customer Order Date Item Quantity Price Total Sale Amount




i want below columns to be generated when i say export.


Sales Representative
Region
Item
Quantity
Price





can some one please help tweek below code ?.


Code:
Option Explicit


Sub ExportData()
'http://www.howtoexcel.org/
'John MacDougall 2017-05-07


'Declare variables
Dim ArrayItem As Long
Dim ws As Worksheet
Dim ArrayOfUniqueValues As Variant
Dim SavePath As String
Dim ColumnHeadingInt As Long
Dim ColumnHeadingStr As String
Dim rng As Range


'Set the worksheet to
Set ws = Sheets("Data")


'Set the save path for the files created
SavePath = Range("FolderPath")


'Set variables for the column we want to separate data based on
ColumnHeadingInt = WorksheetFunction.Match(Range("ExportCriteria").Value, Range("Data[#Headers]"), 0)
ColumnHeadingStr = "Data[[#All],[" & Range("ExportCriteria").Value & "]]"


'Turn off screen updating to save runtime
Application.ScreenUpdating = False


'Create a temporary list of unique values from the column we want to
'separate our data based on
Range(ColumnHeadingStr & "").AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=Range("UniqueValues"), Unique:=True


'Sort our temporary list of unique values
ws.Range("UniqueValues").EntireColumn.Sort Key1:=ws.Range("UniqueValues").Offset(0, 0), _
    Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


'Add unique field values into an array
'ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(ws.Range("IV2:IV" & Rows.Count).SpecialCells(xlCellTypeConstants))
ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(ws.Range("UniqueValues").EntireColumn.SpecialCells(xlCellTypeConstants))


'Delete the temporary values
ws.Range("UniqueValues").EntireColumn.Clear


'Loop through our array of unique field values, copy paste into new workbooks and save
For ArrayItem = 1 To UBound(ArrayOfUniqueValues)
    ws.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
    ws.Range("Data[#All]").SpecialCells(xlCellTypeVisible).Copy
    Workbooks.Add
    Range("A1").PasteSpecial xlPasteAll
    ActiveWorkbook.SaveAs SavePath & ArrayOfUniqueValues(ArrayItem) & Format(Now(), " YYYY-MM-DD hhmmss") & ".xlsx", 51
    ActiveWorkbook.Close False
    ws.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt
Next ArrayItem


ws.AutoFilterMode = False
MsgBox "Finished exporting!"
Application.ScreenUpdating = True
    
End Sub


enclosed raw and code file for your referne.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,626
Office Version
  1. 365
Platform
  1. Windows
You're welcome
 

Some videos you may like

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

Hudson Andrew

New Member
Joined
Sep 28, 2016
Messages
27
Hi Friend need one last tweek out of your busy time if you are not too busy ..

Code:
[LEFT][COLOR=#333333][FONT=monospace]ActiveWorkbook.SaveAs Pth & Cl.Value & format(Now(), " YYYY-MM-DD hhmmss") & ".xlsx", 51
[/FONT][/COLOR][/LEFT]

Can the code be save the workbook to "Expenses report" and as of todays date .?

thanks
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,626
Office Version
  1. 365
Platform
  1. Windows
Is "Expenses report" the folder you want to save the file in, or do you want that as the file name?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,626
Office Version
  1. 365
Platform
  1. Windows
Ok, try
Code:
ActiveWorkbook.SaveAs Pth & "Expenses report " & format(Now(), " YYYY-MM-DD hhmmss") & ".xlsx", 51
 

Watch MrExcel Video

Forum statistics

Threads
1,127,736
Messages
5,626,592
Members
416,194
Latest member
Dhisilva_aguiar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top