Skip to main content
replaced http://stackoverflow.com/ with https://stackoverflow.com/
Source Link
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

Sub PrepareForCSV()

Call CreateBackup
Dim cell1 As Range
Set cell1 = ActiveWorkbook.ActiveSheet.UsedRange
'PART 1:
'Goal: to accomplish setup described here - http://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/4778011

Sub PrepareForCSV()

Call CreateBackup
Dim cell1 As Range
Set cell1 = ActiveWorkbook.ActiveSheet.UsedRange
'PART 1:
'Goal: to accomplish setup described here - https://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 https://stackoverflow.com/a/6993228/4778011

fixed formatting
Source Link
TheCoffeeCup
  • 9.5k
  • 4
  • 38
  • 96

This is my first program in VBA,. I understand I dodid a lot of stupid things, and I would love to be humiliated ;-)... But with reasons, so I can improve. I am happy that this implementation allows me to achieve my goal so far, but I think it might be unstable in case if my colleagues try harder (unconsciously) to break it. In

In the code below I am trying to change all cells to text format, keeping their values as they are displayed and replacing all the empty cell values by - character "-". Also, I try to remove the duplicated double quotes which might appear. Please

Please, tell me, how would you improve it to preserve the behavior and make it more transparent? Would you use such tool and why?

This is my first program in VBA, I understand I do a lot of stupid things, I would love to be humiliated ;-) But with reasons, so I can improve. I am happy that this implementation allows me to achieve my goal so far, but I think it might be unstable in case if my colleagues try harder (unconsciously) to break it. In the code below I am trying to change all cells to text format, keeping their values as they are displayed and replacing all the empty cell values by - character "-". Also, I try to remove the duplicated double quotes which might appear. Please, tell me, how would you improve it to preserve the behavior and make it more transparent? Would you use such tool and why?

This is my first program in VBA. I understand I did a lot of stupid things, and I would love to be humiliated... But with reasons, so I can improve. I am happy that this implementation allows me to achieve my goal so far, but I think it might be unstable in case if my colleagues try harder (unconsciously) to break it.

In the code below I am trying to change all cells to text format, keeping their values as they are displayed and replacing all the empty cell values by - character "-". Also, I try to remove the duplicated double quotes which might appear.

Please, tell me, how would you improve it to preserve the behavior and make it more transparent? Would you use such tool and why?

Source Link

Reusable VBA macro to prevent Excel from destroying the data (+ backup capacity)

My goal is to prepare the Excel file (see the download link at the end) I would share with my non-technical colleagues, so that they enter some data into it and then I was able to automatically generate CSV without having to manually change format of dates, leading zeros and in other special cases (this CSV I will later use to test another app).

This is my first program in VBA, I understand I do a lot of stupid things, I would love to be humiliated ;-) But with reasons, so I can improve. I am happy that this implementation allows me to achieve my goal so far, but I think it might be unstable in case if my colleagues try harder (unconsciously) to break it. In the code below I am trying to change all cells to text format, keeping their values as they are displayed and replacing all the empty cell values by - character "-". Also, I try to remove the duplicated double quotes which might appear. Please, tell me, how would you improve it to preserve the behavior and make it more transparent? Would you use such tool and why?

Sub PrepareForCSV()

Call CreateBackup
Dim cell1 As Range
Set cell1 = ActiveWorkbook.ActiveSheet.UsedRange
'PART 1:
'Goal: to accomplish setup described here - http://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/4778011