Sub PrepareForCSV()
Call CreateBackup
Dim cell1 As Range
Set cell1 = ActiveWorkbook.ActiveSheet.UsedRange
'PART 1:
'Goal: to accomplish setup described here - httphttps://stackoverflow.com/questions/165042/stop-excel-from-automatically-converting-certain-text-values-to-dates
For Each cell1 In cell1
'The check below would help, but it does not work because of Excel internal behaviour
' If (InStr(1, cell1.Value, "=") = 0) Then
' 'cell1.Value = "=" & cell1.Value
' cell1.NumberFormat = "@"
'inserting - sign to avoid blank cells within UsedRange
'if the cell is empty and format is not text
If cell1.Value = "" And cell1.NumberFormat <> "@" Then
cell1.Value = "=" & """" & "-" & """"
cell1.NumberFormat = "@"
'if the cell is empty and format is text
ElseIf cell1.Value = "" And cell1.NumberFormat = "@" Then
cell1.Value = "-"
cell1.NumberFormat = "@"
'if the cell starts with double quote followed by = sign and format is not text
ElseIf (InStr(1, cell1.Value, """=") = 0 And cell1.NumberFormat <> "@") Then
cell1.Value = "=" & """" & cell1.Value & """"
cell1.NumberFormat = "@"
'if the cell starts with double quote and format is not text
ElseIf (InStr(1, cell1.Value, """") = 0 And cell1.NumberFormat <> "@") Then
cell1.Value = "=" & """" & cell1.Value & """"
cell1.NumberFormat = "@"
Else
'probably the code bellow is not needed:
' If cell1.Value <> "" Then
'' cell1.Value = "=" & """" & cell1.Value & """"
'' cell1.NumberFormat = "@"
' Else
' cell1.Value = "=" & """" & "-" & """"
' cell1.NumberFormat = "@"
' End If
End If
Next
'PART 2: replace all unwanted characters
Dim fnd As Variant
Dim rplc As Variant
'replace characters which may cause errors when csv is imported
fnd = ":"
rplc = "!"
ActiveWorkbook.ActiveSheet.Cells.Replace What:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
'replace duplicated double quotes
ActiveWorkbook.ActiveSheet.Cells.Replace What:="""""", Replacement:="""", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
'replace duplicated double quotes for the second time, in case if they are still there
ActiveWorkbook.ActiveSheet.Cells.Replace What:="""""", Replacement:="""", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
End Sub
The entire package for review and testing (I separated macros from XLSX for security reasons - you can merge them on your machine) - workbook with supporting macros, mainly backup-restore sheet capacity which allows to play with PrepareForCSV with ease leveraging the backup capacity - with all the credit to @aevanko for his answer http://stackoverflow.com/a/6993228/4778011https://stackoverflow.com/a/6993228/4778011