HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

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

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
destroyingpreventtheexcelcapacityreusablemacrovbafromdata

Problem

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 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?

```
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

Solution

Overall, your first program in VBA looks pretty good. I've made some modifications below to illustrate a few points that may help you in the future.

  • Using Call to call the CreateBackup sub is not necessary and is generally not used much anymore. (However, on a single line like this, I've seen it used to more clearly show that another sub is performing work.)



  • Indenting your code may have gotten messed up when you posted here to SO, but the code below has each logical level indented to highlight where the different logic paths go.



  • You re-used cell1 for both the UsedRange and the individual cell value within your loop. That's a big no-no. Use specific names to clearly note what each variable refers, such as thisCell and allCells.



  • Nearly all the references within your first loop are to thisCell. In this situation, encapsulate the code in a With block. This compiles to a common variable reference without having to reevaluate the fully specified name each time. It also gives you somewhat faster executing code.



  • Separate your logic into levels to make it easier to follow. In your case, when the cell value is empty and when it's not. Then again when the NumberFormat is not text. It's easy to get lost in a single If statement that has many different parts.



  • Finally, you're making multiple character replacements at the end and you might encounter other character-pairs that need replacing too. To make your code more easily expandable, the find and replace characters can be added to arrays and accessed in a loop. Only the array assignment would change then.



Option Explicit

Sub PrepareForCSV()
    CreateBackup
    Dim thisCell As Range
    Dim allCells As Range
    Set allCells = 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 thisCell In allCells
        With thisCell
            '--- inserting - sign to avoid blank cells within UsedRange
            '    if the cell is empty...
            If IsEmpty(.Value) Then
                If .NumberFormat <> "@" Then
                    '--- if the format is not text
                    .Value = "=" & """" & "-" & """"
                    .NumberFormat = "@"
                Else
                    '--- if the format is text
                    .Value = "-"
                    .NumberFormat = "@"
                End If

            ElseIf .NumberFormat <> "@" Then
                '--- if the cell isn't empty and not formatted as text
                If InStr(1, .Value, """=") = 0 Then
                    '--- starts with "=
                    .Value = "=" & """" & cell1.Value & """"
                    .NumberFormat = "@"

                ElseIf InStr(1, .Value, """") = 0 Then
                    '--- starts with "
                    .Value = "=" & """" & cell1.Value & """"
                    .NumberFormat = "@"
                Else
                    '--- do nothing?
                End If
            Else
                '--- do nothing?
            End If
        End With
    Next

    '--- PART 2: replace all unwanted characters
    Dim fnd() As Variant
    Dim rplc() As Variant
    Dim i As Integer

    '--- replace characters which may cause errors when csv is imported
    fnd = Array(":", """""", """""")
    rplc = Array("!", """", """")

    For i = 1 To UBound(fnd, 1)
        ActiveWorkbook.ActiveSheet.Cells.Replace What:=fnd(i), Replacement:=rplc(i), _
                                                 LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                                                 SearchFormat:=False, ReplaceFormat:=False
    Next i
End Sub

Code Snippets

Option Explicit

Sub PrepareForCSV()
    CreateBackup
    Dim thisCell As Range
    Dim allCells As Range
    Set allCells = 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 thisCell In allCells
        With thisCell
            '--- inserting - sign to avoid blank cells within UsedRange
            '    if the cell is empty...
            If IsEmpty(.Value) Then
                If .NumberFormat <> "@" Then
                    '--- if the format is not text
                    .Value = "=" & """" & "-" & """"
                    .NumberFormat = "@"
                Else
                    '--- if the format is text
                    .Value = "-"
                    .NumberFormat = "@"
                End If

            ElseIf .NumberFormat <> "@" Then
                '--- if the cell isn't empty and not formatted as text
                If InStr(1, .Value, """=") = 0 Then
                    '--- starts with "=
                    .Value = "=" & """" & cell1.Value & """"
                    .NumberFormat = "@"

                ElseIf InStr(1, .Value, """") = 0 Then
                    '--- starts with "
                    .Value = "=" & """" & cell1.Value & """"
                    .NumberFormat = "@"
                Else
                    '--- do nothing?
                End If
            Else
                '--- do nothing?
            End If
        End With
    Next

    '--- PART 2: replace all unwanted characters
    Dim fnd() As Variant
    Dim rplc() As Variant
    Dim i As Integer

    '--- replace characters which may cause errors when csv is imported
    fnd = Array(":", """""", """""")
    rplc = Array("!", """", """")

    For i = 1 To UBound(fnd, 1)
        ActiveWorkbook.ActiveSheet.Cells.Replace What:=fnd(i), Replacement:=rplc(i), _
                                                 LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                                                 SearchFormat:=False, ReplaceFormat:=False
    Next i
End Sub

Context

StackExchange Code Review Q#133234, answer score: 5

Revisions (0)

No revisions yet.