VBA macro to sort and ROUNDUP and save sheet to file

[MasterBash]

Hello,

31714

Added a workbook example.

I am looking to create some macros, that I will be adding to the "Master" sheet, but it will be manipulating the "Data" sheet. The data sheet does not contain a table.

The first macro, I would like to sort column K then C from the Data sheet, then I would like to ROUNDUP 3 decimals on the I column.

The second macro, I would to save the Data sheet only in CSV file format, using the name in A2 cell from the Master sheet (load number). I would like it to be saved in the same folder as the original file.

Is it possible to do those things ? If so, how would I accomplish this ?

Thank you !

[Aussiebear]

Maybe try something like this?



Sub SortMultipleColumns()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Data")
With ws.Sort
.SortFields.Clear
.SortFields.Add Key:=ws.Range("K1"), Order:=xlAscending
.SortFields.Add Key:=ws.Range("C1"), Order:=xlAscending
.Header = xlYes
.Apply
End With
End Sub

[MasterBash]

Thank you, Aussiebear.

Unfortunately, it is not working. No error, it just doesn't do anything. :(

[jdelano]

Give this code a try, I added 2 buttons on Master for the two macros.



Option Explicit


Private Sub btnSaveDataCSV_Click()

Dim csvFileName As String
Dim fs As FileSystemObject ' ***** need Microsoft Scripting Runtine Reference
Dim exportFile As TextStream
Dim dataSheet As Worksheet
Dim dataSheetRow As Long
Dim dataSheetCol As Integer
Dim lastRow As Long
Dim lastColumn As Integer
Dim csvLine As String

' save the current data on the data sheet to a CSV file
csvFileName = GetFolder
If csvFileName = "" Then Exit Sub

csvFileName = csvFileName & "\" & ThisWorkbook.Sheets("Master").Range("A2") & ".csv"

If MsgBox("Would you like to create " & csvFileName & "?", vbYesNo, "Confirm") = vbNo Then Exit Sub
Set fs = New FileSystemObject

' create the file - Should the file be overwritten without warning???
Set exportFile = fs.CreateTextFile(csvFileName, True)
Set dataSheet = ThisWorkbook.Sheets("Data")

lastRow = dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row
lastColumn = dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft).Column

' loop through the rows and columns to create the csv file
' ********** assumes there is never a header row ******************
For dataSheetRow = 1 To lastRow
csvLine = "" ' start a new line of csv to write to the file


For dataSheetCol = 1 To lastColumn
csvLine = csvLine & dataSheet.Cells(dataSheetRow, dataSheetCol).Value & "," ' append each columns data to the line
Next dataSheetCol

csvLine = Left(csvLine, Len(csvLine) - 1) ' remove the last comma

exportFile.WriteLine csvLine ' write it to the file
Next dataSheetRow

exportFile.Close
Set exportFile = Nothing
Set dataSheet = Nothing
Set fs = Nothing

MsgBox "The file " & csvFileName & " has been created"

End Sub


Function GetFolder() As String
' display a dislogbox to the user to select where
' to save the CSV file
Dim fldr As FileDialog
Dim sItem As String

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With


NextCode:
GetFolder = sItem
Set fldr = Nothing


End Function


Private Sub btnSort_Click()


Dim dataSheet As Worksheet
Dim dataRange As Range
Dim colIRange As Range
Dim colICell As Range

Dim lastRow As Long

' set the objects to use
Set dataSheet = ThisWorkbook.Sheets("Data")
'dataSheet.Select

' find the last row used on the data sheet
lastRow = dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row
Set dataRange = dataSheet.Range("A1:K" & CStr(lastRow))
'dataRange.Select

' sort the dataSheet range on col K and C
With dataRange
.Sort Key1:=dataSheet.Range("K1"), Order1:=xlAscending, _
Key2:=dataSheet.Range("C1"), Order2:=xlAscending, _
Header:=xlNo
End With

' format column I numbers to use 3 decimal places
Set colIRange = dataSheet.Range("I1:I" & CStr(lastRow))
colIRange.ClearFormats

' in order to use the roundup function, it is required that you
' loop through each cell in a range
For Each colICell In colIRange
colICell.Value = Application.WorksheetFunction.RoundUp(colICell.Value, 3)
Next colICell

' clear the objects used
Set colIRange = Nothing
Set dataRange = Nothing
Set dataSheet = Nothing

MsgBox "The sort and rounding are done."

End Sub

[MasterBash]

Oh wow, thank you so much !! I will test it out at work tomorrow. :)
I sincerely appreciate it. It appears to work really well. I will post an update tomorrow, after I test it out.

[jdelano]

You're welcome, happy to help. It is longer than it has to be, but I always lean towards trying to make it readable.

[MasterBash]

Thanks again. Unfortunately, I did not have a chance to try it out at work. I am also waiting for my team to try it out. I will provide feedback. :)

[MasterBash]

Alright, I was able to test it out today and I can say it works great !

Unfortunately, I came across a problem when using the sheet Currency Converter. It is not a problem with the script at all, but a new problem I came across after testing my workbook. When I write down monetary values in column G of the Data sheet, lets say I use MXN currency and I wish to replace it with CAD values, I copy and paste the column A from Currency Converter to Data sheet (Column G), and the cell has 2 decimals, but the formula has more than 2, causing a problem.

Here is an example :

31725

So the currently values in "Data" column G have to be replaced with the values from the sheet "Currency Converter" column A. I copy-paste the values to column E as an example. We can see the 2 decimals when we look at the cell, but when we click on it, the formula has more than 2 decimals.

What is the best way around this issue ?

Thank you ! :)