View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
Steve Steve is offline
external usenet poster
 
Posts: 1,814
Default Request for Help in Developing a Macro for a Billing Applicati

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 Belville
Clinical Information Systems Trainer


"Tom Hutchins" wrote:

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" wrote:

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 Belville
Clinical Information Systems Trainer


"Tom Hutchins" wrote:

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

"Steve" wrote:

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,
--
Steve Belville
Clinical Information Systems Trainer