Unconsolidate data

[bmatthewstevens]

I have tried my hand at macos, and what's left of my hair is starting to fall out... could anyone help me with a macro to unconsolidate an excel file? If it was only a few I would just do it by hand, but I'm filling in for a co-worker who quit and this is nothing that I've done before, I'm in networking.

Here is what I have

GL Number	IVNUM	Charge Description	Financial Class	Qty	Charges	Total Qty	Total Charges
10000.000	99003	BALANCE TRANSFER	MEDICARE	658​	2,844.62
10000.000			MEDICAID	42​	3,106.39
10000.000			BLUE CROSS	692​	(2,576.55)
10000.000			COMMERCIAL	643​	(4,903.98)
10000.000			HMO/PPO		-
10000.000			PRIVATE	1022​	1,614.98	3057​	85.46
10203.000	9903000	TRANSFERS TO/ FROM SURGERY CLINIC	MEDICARE		-
10203.000			MEDICAID		-
10203.000			BLUE CROSS	1​	148.15
10203.000			COMMERCIAL		-
10203.000			HMO/PPO		-
10203.000			PRIVATE		-	1​	148.15
10234.000	99006	REFUND FROM AR	MEDICARE	62​	35,987.42
10234.000			MEDICAID	27​	2,336.62
10234.000			BLUE CROSS	441​	56,376.17
10234.000			COMMERCIAL	119​	33,105.98
10234.000			HMO/PPO		-
10234.000			PRIVATE	13​	1,141.38	662​	128,947.57

Here is what I need it to look like.

GLNUM	IVNUM	Desc	Medicare QTY	Medicare AMT	Medicaid QTY	Medicaid AMT	BC QTY	BC AMT	COM QTY	COM AMT	PP QTY	PP AMT	TOTAL QTY	TOTAL
10000.000	99003	BALANCE TRANSFER	392	$46.40	8	$0.00	328	$44.02	295	-$148.66	189	$11.79	1212	-$46.45
10203.000	9903000	TRANSFERS TO/ FROM SURGERY CLINIC		$0.00		$0.00	5	-$143.48		$0.00	1	-$26.28	6	-$169.76
10234.000	99006	REFUND FROM AR	55	$9,876.78	7	$388.28	138	$14,858.17	58	$25,350.24	5	$226.84	263	$50,700.31

 

[Alex Blakenburg]

Apart from the change below, Johnny's code seems to be working ok on my machine.
Have you rebooted your machine and tried running it again ?

The code does all the output it one go, so how are you determining it is 20% done ?

If it is still erroring out add this 2nd line below after the line shown and tell us what it says.

    SourceArray = SourceWS.Range("A2:H" & SourceWS.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row)           ' Load source data into 2D 1 based SourceArray
    '  Add this line to test the Last Row / Size
    MsgBox "SourceArray Rows " & UBound(SourceArray, 1)

The change you need to make to his code is to swap out replace "-" xlPart with xlWhole ie
as it stands it is converting your negatives to positives.

    With ActiveSheet.UsedRange
        .Replace "-", 0, xlWhole, , , , False, False                                                                     ' Replace the dashes with zeros
        .Value = .Value
   End With

 

[bmatthewstevens]

Apart from the change below, Johnny's code seems to be working ok on my machine.
Have you rebooted your machine and tried running it again ?

The code does all the output it one go, so how are you determining it is 20% done ?

If it is still erroring out add this 2nd line below after the line shown and tell us what it says.

    SourceArray = SourceWS.Range("A2:H" & SourceWS.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row)           ' Load source data into 2D 1 based SourceArray
    '  Add this line to test the Last Row / Size
    MsgBox "SourceArray Rows " & UBound(SourceArray, 1)

The change you need to make to his code is to swap out replace "-" xlPart with xlWhole ie
as it stands it is converting your negatives to positives.

    With ActiveSheet.UsedRange
        .Replace "-", 0, xlWhole, , , , False, False                                                                     ' Replace the dashes with zeros
        .Value = .Value
   End With

I am figuring the 20% because i have 28,000 lines that it needs to turn into like 6-7 thousand,... it will turn 4500 into 800 lines perfect. but then it throws the memory error.

 

[Alex Blakenburg]

Did you try including the message box line ? What number of rows is the msgbox showing ?

 

[bmatthewstevens]

That totally fixed it...

I don't know how to mark both of yours as a solution, but you guys seriously saved me days of manual work...

How can I buy you a beer?

 

[Alex Blakenburg]

Not sure what bit fixed it but its Johnny's code that provided you with the solution

 

[bmatthewstevens]

well I found one of the charge descriptions had the data surrounded by =>data>=

that was freaking the code out it looks like, I ran a simple find and replace removed them all and it worked like a charm.

 

[Alex Blakenburg]

Thanks for letting us know. We can probably build that into the code if you need us to.

 

[johnnyL]

The change you need to make to his code is to swap out replace "-" xlPart with xlWhole ie
as it stands it is converting your negatives to positives.

    With ActiveSheet.UsedRange
        .Replace "-", 0, xlWhole, , , , False, False                                                                     ' Replace the dashes with zeros
        .Value = .Value
   End With

Nice catch @Alex Blakenburg!

Here is a corrected version:

Sub ConsolidateV2()
'
    Dim ResultsSheetMissing     As Boolean
    Dim ArrayRow                As Long, DestinationRow     As Long
    Dim ResultsSheetName        As String
    Dim DestinationArray()      As Variant, SourceArray     As Variant
    Dim HeaderTitlesToPaste     As Variant
    Dim DestinationWS           As Worksheet, SourceWS      As Worksheet
'
'-----------------------------------------------------------------------------------------------------------------------
'
    ResultsSheetName = "Results Sheet"                                                                                  ' <--- Set this to the name of the destination sheet
    Set SourceWS = Sheets("Sheet1")                                                                                     ' <--- Set this to the name of the source sheet
'

'
'-----------------------------------------------------------------------------------------------------------------------
'
    HeaderTitlesToPaste = Array("GLNUM", "IVNUM", "Charge Desc", "Medicare QTY", "Medicare AMT", "Medicaid QTY", _
            "Medicaid AMT", "BC QTY", "BC AMT", "COM QTY", "COM AMT", "HMO/PPO QTY", "HMO/PPO AMT", "Private QTY", _
            "Private AMT", "Total Qty", "Total Charges")                                                                ' Header row to paste to destination sheet
'
    ResultsSheetMissing = Evaluate("IsError(Cell(""col"",'" + ResultsSheetName + "'!A1))")                              ' If ResultsSheetMissing = False then the sheet does exist
'
    If ResultsSheetMissing = False Then                                                                                 ' If the ResultsSheetName exists then
        Application.DisplayAlerts = False                                                                               '   Turn DisplayAlerts off ... sheet deletion causes popup
        Sheets(ResultsSheetName).Delete                                                                                 '   Delete the sheet
        Application.DisplayAlerts = True                                                                                '   Turn DisplayAlerts back on
    End If
'
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = ResultsSheetName                                                     ' Add the ResultsSheet & name it
    Set DestinationWS = Sheets(ResultsSheetName)                                                                        ' Set the DestinationWS
'
    SourceArray = SourceWS.Range("A2:H" & SourceWS.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row)           ' Load source data into 2D 1 based SourceArray
'
    ReDim DestinationArray(1 To UBound(SourceArray, 1), 1 To 17)
'
    DestinationRow = 0                                                                                                  ' Initialize DestinationRow
'
    For ArrayRow = 1 To UBound(SourceArray, 1) Step 6                                                                   ' Loop through the SourceArray rows
        DestinationRow = DestinationRow + 1                                                                             '   Increment DestinationRow
        DestinationArray(DestinationRow, 1) = SourceArray(ArrayRow, 1)                                                  '   GLNUM
        DestinationArray(DestinationRow, 2) = SourceArray(ArrayRow, 2)                                                  '   IVNUM
        DestinationArray(DestinationRow, 3) = SourceArray(ArrayRow, 3)                                                  '   Charge Desc
        DestinationArray(DestinationRow, 4) = SourceArray(ArrayRow, 5)                                                  '   Medicare QTY
        DestinationArray(DestinationRow, 5) = SourceArray(ArrayRow, 6)                                                  '   Medicare AMT
        DestinationArray(DestinationRow, 6) = SourceArray(ArrayRow + 1, 5)                                              '   Medicaid QTY
        DestinationArray(DestinationRow, 7) = SourceArray(ArrayRow + 1, 6)                                              '   Medicaid AMT
        DestinationArray(DestinationRow, 8) = SourceArray(ArrayRow + 2, 5)                                              '   BC QTY
        DestinationArray(DestinationRow, 9) = SourceArray(ArrayRow + 2, 6)                                              '   BC AMT
        DestinationArray(DestinationRow, 10) = SourceArray(ArrayRow + 3, 5)                                             '   COM QTY
        DestinationArray(DestinationRow, 11) = SourceArray(ArrayRow + 3, 6)                                             '   COM AMT
        DestinationArray(DestinationRow, 12) = SourceArray(ArrayRow + 4, 5)                                             '   HMO/PPO QTY
        DestinationArray(DestinationRow, 13) = SourceArray(ArrayRow + 4, 6)                                             '   HMO/PPO AMT
        DestinationArray(DestinationRow, 14) = SourceArray(ArrayRow + 5, 5)                                             '   Private QTY
        DestinationArray(DestinationRow, 15) = SourceArray(ArrayRow + 5, 6)                                             '   Private AMT
        DestinationArray(DestinationRow, 16) = SourceArray(ArrayRow + 5, 7)                                             '   Total Qty
        DestinationArray(DestinationRow, 17) = SourceArray(ArrayRow + 5, 8)                                             '   Total Charges
    Next                                                                                                                ' Loop back
'
    DestinationWS.Range("A1:Q1").Value = HeaderTitlesToPaste                                                            ' Write header row to DestinationSheet
'
    DestinationWS.Range("A2").Resize(UBound(DestinationArray, 1), UBound(DestinationArray, 2)) = DestinationArray       ' Write the DestinationArray to the destination sheet
'
    DestinationWS.Columns("A:A").NumberFormat = "0.000"                                                                 ' Format column A in the destination sheet to 3 decimal places
'
    DestinationWS.Range("E:E,G:G,I:I,K:K,M:M,O:O,Q:Q").NumberFormat = "#,##0.00_);(#,##0.00)"                           ' Format the Amount columns on the destination sheet
'
    ActiveSheet.UsedRange.Replace "-", 0, xlWhole, , , , False, False                                                   ' Replace the dashes with zeros
'
    DestinationWS.UsedRange.Columns.AutoFit                                                                             ' Autofit the widths of all used columns
End Sub

 

[johnnyL]

@johnnyL <--- Fell asleep at the wheel.