Solved: Used Range Selective ClearFormat

[stanl]

I doubt this is possible, but if it is: assuming you have a used range that contains cells formatted as percents and as dates. You want to convert to .csv but want 90.0% to come out as .9 and 2/18/2013 to come out as a date not 41323.

Is there a method to clear all formats except date?

[Artik]

I doubt this is possible

Too quickly you lose hope

Try this macro. It exports UsedRange form active sheet to csv file.
[VBA]Sub ExportToCSV()
Dim vArr As Variant
Dim fname As Variant
Dim wkbNew As Workbook

vArr = ActiveSheet.UsedRange.Value

Application.ScreenUpdating = False
Application.EnableEvents = False

Set wkbNew = Workbooks.Add(xlWBATWorksheet)

wkbNew.Worksheets(1).Range("A1").Resize(UBound(vArr), UBound(vArr, 2)).Value = vArr

fname = Application.GetSaveAsFilename(FileFilter:="CSV Files (*.csv), *.csv")

If fname <> False Then
wkbNew.SaveAs Filename:=fname, FileFormat:=xlCSV
End If

wkbNew.Close False
Application.EnableEvents = True
End Sub[/VBA]

Artik

[stanl]

Too quickly you lose hope

You missed the point. I know how to create and export as CSV. My concerns are with the output. Assume I have a used range with both a date column and a percent column. When exported as CSV the date might come out as 2/20/2013 and the percent as 93.2%

If I selection.clearformats prior to the export, the percent will come out .932 (which I want) but the date will come out as a numeric. I want the best of both worlds.

[Artik]

Have you tried this macro? Does it work incorrectly?

Artik

[stanl]

Yes it did, I was trying to avoid creating the extra workbook. I apologize for my earler remark about 'missing the point'.

[Artik]

Does the problem can be considered as solved?

Artik

[stanl]

Does the problem can be considered as solved?

Artik

Unfortunately No. If the used range has currency would like to drop the $ in the csv, and also convert TRUE to 1 (or -1) and FALSE to 0. I can make these changes with file i/o (search and replace), but that could be affected by the size of the used range.

[Artik]

In a simple way you can not do that, I think. You will need to convert the data.
For example (I assumed that in the first row is a header table):[VBA]Sub ExportToCSV_2()
Dim vArr As Variant
Dim fname As Variant
Dim wkbNew As Workbook
Dim rngUsdRng As Range
Dim Rng As Range
Dim r As Long, c As Integer

Set rngUsdRng = ActiveSheet.UsedRange

vArr = rngUsdRng.Value2

For Each Rng In rngUsdRng.Rows(2).Cells
c = Rng.Column

Select Case TypeName(Rng.Value)
Case "Date"
For r = 1 To rngUsdRng.Rows.Count
If IsNumeric(vArr(r, c)) Then
vArr(r, c) = CDate(vArr(r, c))
End If
Next r
Case "Boolean"
For r = 1 To rngUsdRng.Rows.Count
If IsNumeric(vArr(r, c)) Then
vArr(r, c) = -Int(vArr(r, c))
End If
Next r
End Select
Next Rng

Application.ScreenUpdating = False
Application.EnableEvents = False

Set wkbNew = Workbooks.Add(xlWBATWorksheet)

wkbNew.Worksheets(1).Range("A1").Resize(UBound(vArr), UBound(vArr, 2)).Value = vArr

fname = Application.GetSaveAsFilename(FileFilter:="CSV Files (*.csv), *.csv")

If fname <> False Then
wkbNew.SaveAs Filename:=fname, FileFormat:=xlCSV
End If

wkbNew.Close False
Application.EnableEvents = True
End Sub[/VBA]

Artik

[mikerickson]

How about

[vba]For each oneCell in SomeSheet.UsedRange
With oneCell
If .NumberFormat Like "*%" Then
.NumberFormat = "0.00###"
End If
End With
Next oneCell[/vba]

[Artik]

OK. A faster version of the above my solution.
[VBA]Sub ExportToCSV_3()
Dim vArr As Variant
Dim vArr1 As Variant
Dim fname As Variant
Dim strTmp As String
Dim strSep As String

Dim rngUsdRng As Range
Dim Rng As Range
Dim r As Long, c As Integer

Dim Tm1 As Single, Tm2 As Single, Tm3 As Single
Dim Tm4 As Single, Tm5 As Single, Tm6 As Single

strSep = Application.International(xlListSeparator)

Tm1 = Timer
Set rngUsdRng = ActiveSheet.UsedRange

vArr = rngUsdRng.Value2
ReDim vArr1(1 To UBound(vArr))

Tm2 = Timer

For Each Rng In rngUsdRng.Rows(2).Cells
c = Rng.Column

Select Case TypeName(Rng.Value)
Case "Date"
For r = 1 To rngUsdRng.Rows.Count
If IsNumeric(vArr(r, c)) Then
vArr(r, c) = CDate(vArr(r, c))
End If
Next r
Case "Boolean"
For r = 1 To rngUsdRng.Rows.Count
If IsNumeric(vArr(r, c)) Then
vArr(r, c) = -Int(vArr(r, c))
End If
Next r
End Select
Next Rng

Tm3 = Timer

For r = 1 To UBound(vArr)
strTmp = vbNullString

For c = 1 To UBound(vArr, 2)
strTmp = strTmp & vArr(r, c) & strSep
Next c

strTmp = Left(strTmp, Len(strTmp) - 1)

vArr1(r) = strTmp
Next r

strTmp = vbNullString

strTmp = Join(vArr1, vbCrLf)

Tm4 = Timer

fname = Application.GetSaveAsFilename(InitialFileName:="", FileFilter:="CSV Files (*.csv), *.csv")

Tm5 = Timer
If fname <> False Then
Call WriteToFile(fname, strTmp)
End If
Tm6 = Timer

MsgBox "Get data: " & Format(Tm2 - Tm1, "0.000") & vbCr & _
"Convert Date & Bool :" & Format(Tm3 - Tm2, "0.000") & vbCr & _
"Create output string: " & Format(Tm4 - Tm3, "0.000") & vbCr & _
"Save csv file: " & Format(Tm6 - Tm5, "0.000")
End Sub[/VBA]

Artik

[stanl]

Thanks. Never used Value2. I'll mark as solved. This is related to a temporary task of converting Excel tabs with more than 255 columns into a SQL Server Express table (SSIS is not available to automate on Express).

This involves iterating the Excel columns to determine the data type and creating a .sql file to create the table in SQL Server. After which the Excel data is exported to csv then a BULK INSERT command can be issued via ADO to upload the csv to the table.

I wanted to avoid data mismatch errors due to the formatting of the csv output.

Your code appears to overcome the major obstacles. Thanks again.

Stan

[Artik]

Sorry, I forgot to add the procedure WriteToFile.
[VBA]Sub WriteToFile(ByVal strFilename As String, strOutput As String)
Dim iFn As Integer


iFn = FreeFile
Open strFilename For Append Access Write As #iFn

Print #iFn, strOutput

Close #iFn

End Sub[/VBA]

Artik