Extract specific values in column A and append to the end of each record

Jaffey · May 5th 2019

I receive a Crystal Reports.xls file each day that contains a list of payments similar to the one shown in the picture below. I would like to loop through the file and append the name of the law firm, payment type and clerk name to the end of each payment record.

The client name and law firm name appear only once at the top of the report as shown in the picture'
The Payment type is either Non-Direct or Direct.
The clerk names can change all the time but they always precede an actual payment record(s)
I have attached a sample file as well. Any assistance appreciated!!

[ATTACH=JSON]{"data-align":"none","data-size":"full","title":"OZ Payment file pic.JPG","data-attachmentid":1218219}[/ATTACH]

jolivanes · May 14th 2019

If you change your setup to sheets without "Merged and Center" and "Wrap Text", someone might take the time to help but these two formats are a royal pain.
I had a look but got turned of by that.
Good luck

**KjBox** · May 14th 2019

You also need to get rid of the empty row above each sub-total. Writing inefficient code to cater to a badly designed spreadsheet is very bad practice and very few forum members will do it.

jolivanes · May 14th 2019

Have a look at the attached.

jolivanes · May 15th 2019

If you just want the 4 columns of extra data starting in column M, you could use the slimmed down version of the code in the attachment in the previous post.

Code

Sub Transfer_A()
    Dim myAreas As Areas, i As Long, a As Long, aa As Long
    a = Columns(1).Find("Non-Direct", , , 1).Row
    aa = Columns(1).Find("Direct", , , 1).Row
    Application.ScreenUpdating = False
    Set myAreas = ActiveSheet.Range("A" & a + 1 & ":A" & aa - 1).SpecialCells(2).Areas


    For i = 1 To myAreas.Count
    
    With Range(Cells(myAreas(i).Cells(1).Offset(1).Row, 1), Cells(myAreas(i).End(xlDown).Row, 1))
        .Offset(, 12).Value = Mid(Cells(4, 1), InStr(Cells(4, 1), ":") + 2, 256)
        .Offset(, 13).Value = Mid(Cells(6, 1), InStr(Cells(6, 1), ":") + 2, 256)
        .Offset(, 14).Value = Cells(a, 1).Value
        .Offset(, 15).Value = myAreas(i).Cells(1).Value
    End With
    Next i
    
    Set myAreas = ActiveSheet.Range("A" & aa + 1 & ":A" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(2).Areas
    
    For i = 1 To myAreas.Count
    
    With Range(Cells(myAreas(i).Cells(1).Offset(1).Row, 1), Cells(myAreas(i).End(xlDown).Row, 1))
        .Offset(, 12).Value = Mid(Cells(4, 1), InStr(Cells(4, 1), ":") + 2, 256)
        .Offset(, 13).Value = Mid(Cells(6, 1), InStr(Cells(6, 1), ":") + 2, 256)
        .Offset(, 14).Value = Cells(aa, 1).Value
        .Offset(, 15).Value = myAreas(i).Cells(1).Value
    End With
    Next i
    Application.ScreenUpdating = True
    End Sub

Display More

Jaffey · May 18th 2019

Quote from jolivanes

If you change your setup to sheets without "Merged and Center" and "Wrap Text", someone might take the time to help but these two formats are a royal pain.
I had a look but got turned of by that.
Good luck

Hi jolivanes, I agree merged cells are evil. That's why I specifically mentioned I was receiving a Crystal Reports spreadsheet. SAP Crystal Reports is famous for exporting spreadsheet reports that break all the rules so thank you for answering anyway. Unfortunately, a lot of banks and other companies decided Crystal Reports was a good choice back in the 90's and are still using the original product and that's what I have to deal with here unfortunately. Thanks again for responding! I am going to take a look at your solution now. For some reason Ozgrid did not auto-email me your reply 4 days ago!... which is weird ... my email hasn't changed in years. cheers

Jaffey · May 18th 2019

Quote from KjBox

You also need to get rid of the empty row above each sub-total. Writing inefficient code to cater to a badly designed spreadsheet is very bad practice and very few forum members will do it.

Agree 100%, but when's the last time you saw a bank change their reporting because a contractor like me said their spreadsheet - which was built into their system by Crystal Reports - a third party - over a decade ago - is 'wrong' I will try to be a little clearer about that part of my request next time. Thank you!

jolivanes · May 19th 2019

Have you tried the suggestion in Post #5?

Jaffey · May 19th 2019

Not yet. Apparently they are doing maintenance and citrix is down.

Extract specific values in column A and append to the end of each record

Participate now!

Share