Home / Excel / New Macros for ACA

New Macros for ACA

ACA - New Macros for 2017

Hopefully today's post will be a short post on some of the changes I had to make in the macro that help generate the XML file. The actual generation of the XML file is done through using the Source feature found under the Developer tab in Excel. The method hasn't changed although the starter file will change to incorporate the new namespaces the government is using and to adhere to the government's stipulation of no empty tags. The starter file for the Excel to xml will change just slightly.

The biggest change, so far, is the macro in order to get rid of the empty tags. Getting rid of the empty tags is actually the easy part; it's making sure I have the right set of tags for the section on the employee's share of the minimum cost for his insurance. That was the section I had problem figuring out the solution.

First I want to show the basic codes I used last year to fix the xml file.

Basic structure of ACA macro to fix the Excel to XML conversion

The basic structure is shown to the right.

First I set out the dimensions of the all of the variables I'm using.

Then I reference the xml file as the FileName and I also set Wks to the Excel tab that lists out all of the "find" text and with what to replace the "find" text. For example, in Excel, I could not use the namespaces in the starter xml file because Excel will try to find those namespaces and give me errors, so I had to take them out and use regular field names. In "Replacement List" tab, I have a section of key words to search for those regular field names and replace them with namespaces. There will be different search and replace actions: replacing field names with namespaces, adding in opening tags, adding in closing tags, etc.

The Set fso = CreateObject(...) and Set TextFile = fso.Open..... on through TextFile.Close is the part that creates an object that holds the entire xml code. Note the ReadAll. It reads the entire xml file into the variable Text. This is key. This actually helps speed up the search and replace.

FindValues and ReplaceValues are variables that hold what I want to search and replace. Note that the code references Wks which was set as the "Replacement List" tab in Excel, holding the search and replace values. See how the code references cells?

Finally the section with For I = 1 to UBound on through Next I, is the iterative process that searches each key word in the FindValues and replaces them with ReplaceValues. Because I will have more than one item to search and replace, it is an iterative process, but it is extremely fast. Like nanosecond fast.

Once I do one set of search and replace, I can do another search and replace by starting from the FindValues and ReplaceValues lines and going through the For I = 1 to UBound on through Next I. I can do that piece of code over and over again to search and replace certain kinds of words.

Finally, once I'm done searching everything, I will write out the new results back into the file with TextFile.Write Text section.

Dim FileName As String
Dim fso As Object
Dim FindValues As Variant
Dim I As Long
Dim ReplaceValues As Variant
Dim ReplaceValues2 As Variant
Dim Text As String
Dim TextFile As Object
Dim Wks As Worksheet

FileName = "C:UsersvfrizzellDocumentsVeroniqueNotepad macro testingACA 1095C 1.xml"
Set Wks = Worksheets("Replacement list")

Set fso = CreateObject("Scripting.FileSystemObject")

Set TextFile = fso.OpenTextFile(FileName, 1, False)
Text = TextFile.ReadAll
TextFile.Close

FindValues = Wks.Range("C3:BK3").Value
ReplaceValues = Wks.Range("C4:BK4").Value

For I = 1 To UBound(FindValues, 2)
Text = Replace(Text, FindValues(1, I), ReplaceValues(1, I))
Next I

Set TextFile = fso.OpenTextFile(FileName, 2, False)
TextFile.Write Text
TextFile.Close

New Part to clear out spaces and to handle problems regarding the section on lowest monthly premium for employee

I won't go into too much details into the new macro because you really won't understand the problem unless you have gone through the process. I think you have to go through the problem before you start to see what kind of problems crop up.

This new part takes out all of the blank spaces that were created when I got rid of the empty tags. The government didn't say that there were to be no empty spaces but I decided I needed to get rid of them just to make it easy for me to proofread the xml file.

Note that in this new part, instead of ReadAll, the macro has ReadLine. The macro iteratively reads each xml line into Text rather than read the entire xml file into Text. This the reason why the macro takes so long to run. There was no easy way to find the blank spaces and get rid of them. Well, there is a way but the search and replace finds all blank spaces and scrunches up the code together so that the xml is too hard to read. I really only want to get rid of blank rows, not the blank spaces indenting the rows.

The section in between the dashes are If / End If statements to deal with the problem related to the employee's lowest monthly premium. I tried many ways to do a search and replace in the ReadAll section but I had no success so I am reduced to using the line by line method. You will see there are 3 If / End Ifs statements that I have to go through to figure out whether I want to keep a row or get rid of it.

I won't explain much more than that because it is rather convoluted and I think I will just make a mess of the explanation. Maybe another time. Besides, it is getting late and I have other things I need to do before I head to bed.

lRow = 1
Dim Text2 As String
Text2 = ""

Set TextFile = fso.OpenTextFile(FileName, 1, False)

Do Until TextFile.AtEndOfStream
Text = TextFile.Readline

'Write out information onto "Replacement List" tab for debugging purposes
Wks.Range("G43") = lRow
Wks.Range("G44") = Text
Wks.Range("G45") = Len(Text)
Wks.Range("G46") = Application.IfError(Application.Search("", Text), "")

If Application.IfError(Application.Search("", Text), "") = 4 Then
Text2 = Text
Wks.Range("G47") = Text2
End If

If (Application.IfError(Application.Search("", Text), "") = 5 Or Application.IfError(Application.Search("", Text), "") = 5 Or Application.IfError(Application.Search("", Text), "") = 5 Or Application.IfError(Application.Search("", Text), "") = 5 Or Application.IfError(Application.Search("", Text), "") = 5 Or Application.IfError(Application.Search("", Text), "") = 5 Or Application.IfError(Application.Search("", Text), "") = 5 Or Application.IfError(Application.Search("", Text), "") = 5 Or Application.IfError(Application.Search("", Text), "") = 5 Or Application.IfError(Application.Search("", Text), "") = 5 Or Application.IfError(Application.Search("", Text), "") = 5 Or Application.IfError(Application.Search("", Text), "") = 5) And Application.IfError(Application.Search("", Text2), "") = 4 _
Then
strNewContents = strNewContents & Text2 & vbCrLf
Text2 = ""
End If

If Application.IfError(Application.Search("", Text2), "") = 4 And Application.IfError(Application.Search("", Text), "") = 4 Then
strNewContents = strNewContents
Text2 = ""
Text = ""
Wks.Range("G44") = Text
Wks.Range("G47") = Text2
End If

'If non-blank, then write out line to strNewContents, otherwise skip it
If Len(Text) > 6 And Application.IfError(Application.Search("", Text), "") <> 4 Then
strNewContents = strNewContents & Text & vbCrLf
End If

lRow = lRow + 1
Loop
TextFile.Close

Set TextFile = fso.OpenTextFile(FileName, 2, False)
TextFile.Write strNewContents
TextFile.Close

Leave a Reply

Your email address will not be published. Required fields are marked *

Top