Request for Help in Developing a Macro for a Billing Application

[Steve]

I am looking for help in developing a billing application macro. I have a
spreadsheet with records in rows. At the end of rows are three columns with
cells that may have multiple billing code entries within each cell. For
example, Column M may have three billing codes, and column N may have four.
So in combining both columns, a total of seven records need to be created,
including the original one.

In essence, what the user has requested is to take each of those billing
elements, create distinct rows for each one and then copy the remaining
elements from the exisiting cells in the row to each of the newly created
records.

If this doen't make sense, I would be happy to explain in more detail to any
interested party.

Regards,

 

[Tom Hutchins]

When you say that columns M & N may have multiple billing code entries within
each cell, how are they formatted? What separates or distinguishes each
billing code?

Hutch

 

[paul.robinson]

Hi
How are the billing codes in a cell separated/ commas, colons,
space...?
Where do you want the separated rows to go - a new sheet or replace
the exisiting data with rows having only one billing code each?
Is this a one off job (maybe can be done without code) or something
you will have to do a lot (requiring code)?

regards
Paul

 

[Steve]

Hi Tom-

Thanks for the quick repsonse and understanding of the issue. I am getting
this spreadsheet second hand. It's coming out of our radiology department and
I don't even know for sure if they are importing these records in from
another enterprise application.

With that said, in looking at the spreadsheet, it looks like the codes are
separated by hard returns when I copy and paste as an unformatted text into a
Word Doc.

Does that help?

Regards

 

[Steve]

Hello Paul-

Thanks again for your quick repsonse!

As I answered Tom, when I paste this into a word doc (as if I were using it
as a script) I see hard returns after each of the codes.

They are asking for the new rows to appear in the original spreadsheet with
the original row containing the first billing code, with each row containing
the remaining records.

This is a repetitive job, and I actually have a macro developed by someone
else that seems to separate the rows for the most part but it dosen't do this
consistantly (especially when both of the adjacent columns contain cells of
multiple codes) and it does not copy the preceding columns into the new
record rows.

Regards,
--
Steve Belville
Clinical Information Systems Trainer

Hi
How are the billing codes in a cell separated/ commas, colons,
space...?
Where do you want the separated rows to go - a new sheet or replace
the exisiting data with rows having only one billing code each?
Is this a one off job (maybe can be done without code) or something
you will have to do a lot (requiring code)?

regards
Paul

 

[Steve]

Hi Steve,

If you are seeking someone whom you can pay a reasonable fee to help you
develop your billing application macro, I can help you. I provide users help
with Access, Excel and Word applications for a reasonable fee. You would
need to email me a copy of your spreadsheet with a detailed explanation of
what you need.

Steve
(e-mail address removed)

 

[paul.robinson]

Hi
Just to see how your billing codes are separated, paste this code into
a code module. Replace "A1" in the tester sub with the cell address of
one of the cells containing multiple billing codes. Run the tester sub
and see if you get msgboxes with each billing code in turn. Note that
Chr(10) is a return character.


Sub tester()
Dim myCollection As Collection
Dim Item As Variant
Set myCollection = ParseString(Range("A1").Value, Chr(10))
For Each Item In myCollection
MsgBox Item
Next Item
End Sub

'Parses a string into into pieces and stores as a collection
'separator is the character separating string elements
Function ParseString(myString As String, Separator As String) As
Collection
Dim PlaceComma As Integer 'Identifies position of first comma in a
string
Dim TempString As String, ItemString As String
Dim NoDupes As New Collection
Application.ScreenUpdating = False
On Error Resume Next
If Trim(myString) <> "" Then
TempString = Trim(myString)
PlaceComma = InStr(TempString, Separator)
If PlaceComma = 0 Then
NoDupes.Add TempString, TempString
Else
TempString = TempString & Separator
'While a comma exists in the string
Do While PlaceComma > 0
'Get rid of any leading comma's
Do While PlaceComma = 1
TempString = Trim(Right(TempString,
Len(TempString) - 1))
PlaceComma = InStr(TempString, Separator)
Loop
'If that leaves an empty string, leave the loop
If PlaceComma = 0 Then Exit Do
ItemString = Trim(Left(TempString, PlaceComma -
1))
NoDupes.Add ItemString, ItemString
TempString = Trim(Right(TempString,
Len(TempString) - PlaceComma))
PlaceComma = InStr(TempString, Separator)
Loop
End If
End If
On Error GoTo 0
Set ParseString = NoDupes 'could be empty
Set NoDupes = Nothing
End Function

regards
Paul

 

[Tom Hutchins]

This is a fun problem. Try the following macro. It works perfectly with the
test data I created based on your description. Paste this code in a VBA
module in your workbook and run the macro BillingCodes (rename it to whatever
you want, of course). Change the fifth line of BillingCodes as needed if your
data doesn't start on row 2.

Option Explicit
Public CurrRow As Long, NextRow As Long

Sub BillingCodes()
'Separate every billing code into its own row.
Dim aa As Integer, bb As Integer, Str As String
'Assume data starts in cell A2.
Range("A2").Activate
'Process records in column A until hit an empty cell.
Do While Len(ActiveCell.Value) > 0
CurrRow& = ActiveCell.Row
NextRow = CurrRow& + 1
'Add rows below CurrRow&. Put one billing code in each row.
Call AddRows(Cells(CurrRow&, 13).Value, 13)
Call AddRows(Cells(CurrRow&, 14).Value, 14)
'Copy the data in columns A-L of CurrRow to the new rows.
If (NextRow& - CurrRow&) > 1 Then
Range("A" & CurrRow& & ":L" & CurrRow&).Select
Selection.Copy
Range("A" & (CurrRow& + 1) & ":L" & (NextRow& - 1)).Select
ActiveSheet.Paste
End If
'Delete the original row (CurrRow&).
Range("A" & CurrRow&).EntireRow.Delete
'Move to the next record.
Range("A" & NextRow& - 1).Activate
Loop
End Sub

Private Sub AddRows(BClist As String, WhichCol As Long)
Dim aa As Long, StrOut As String
StrOut$ = vbNullString
'BClist is the value in column 13 or 14 (WhichCol). Contains
'zero to four billing codes separated by line feeds.
For aa& = 1 To Len(BClist$)
Select Case Mid(BClist$, aa&, 1)
'When a line feed is encountered, if anything has been
'accumulated in StrOut, insert a new row below the active row
'and put StrOut$ in WhichCol&. Then reset StrOut$.
Case vbCr, vbLf, vbCrLf
If Len(StrOut$) > 0 Then
Cells(ActiveCell.Row + 1, WhichCol).Select
Selection.EntireRow.Insert
'Increment NextRow& to keep track of which row has the next
'new record.
NextRow& = NextRow& + 1
Cells(ActiveCell.Row, WhichCol).Value = StrOut$
StrOut$ = vbNullString
End If
Case Else
StrOut$ = StrOut$ & Mid(BClist$, aa&, 1)
End Select
Next aa&
'Unless BClist ended with a line feed, there may be characters
'(another billing code) in StrOut$.
If Len(StrOut$) > 0 Then
Cells(ActiveCell.Row + 1, WhichCol).Select
Selection.EntireRow.Insert
NextRow& = NextRow& + 1
Cells(ActiveCell.Row, WhichCol).Value = StrOut$
End If
End Sub

Hope this helps,

Hutch

 

[Steve]

Hello Tom-

I just want to express appreciation for your help. I haven't tried this yet
because I've been swamped with other things since my original post.

I want to assure you that I am grateful for your help and I will get back on
this one as soon as I clear the deck from other Training priorities.

Regards,

 

[Steve]

Hello Paul-

I just want to express appreciation for your help! I don't want to appear
ungrateful, just other things have popped across my desk since my original
post. I plan on looking at this very soon!

Regards,

 

[Steve]

Hello Steve-

Thank you very much for your capable offer to help. My org is so deaparate
though, they have thrown this into the Clincal IS Training department!

But I do thank you for the offer anyway.
--
Steve Belville
Clinical Information Systems Trainer

Hi Steve,

If you are seeking someone whom you can pay a reasonable fee to help you
develop your billing application macro, I can help you. I provide users help
with Access, Excel and Word applications for a reasonable fee. You would
need to email me a copy of your spreadsheet with a detailed explanation of
what you need.

Steve
(e-mail address removed)