Arrange System Generated Data In To User Defined Format

[KRIXX]

I am attaching excel workbook with this thread. After opening this workbook you will see “Sheet1” and “Sheet2”. Sheet1 contains system generated data which can be in thousands of entries. And Sheet2 is the user defined format which I need after running VBA code.

In this attached workbooks Sheet1 contains more data but in Sheet2 for giving you an idea what I want I have manually illustrated and arranged data so it is of first few transactions data.

This system generated data can be huge so please give the VBA which can tackle this data and give me error free output.

I am not able to attached excel workbook here so please find the attached in post #6 for reference in below thread.

Arrange System Generated Data In To User Defined Format

I am attaching excel workbook with this thread. After opening this workbook you will see Sheet1 and Sheet2. Sheet1 contains system generated data which can be in thousands of entries. And Sheet2 is the user defined format which I need after running VBA code. In this attached workbooks Sheet1...

www.excelforum.com

I feels that in above thread I will not get any reply. Please do get me wrong like they treat me in above thread.

 

[Anthony47]

The file can only be downloaded by registered user.

To attach a file, upload it to a filesharing server, then copy the download link that you will be assigned in your next message. The simplest sharing service I know is filedropper.com

Bye

 

[Fluff]

Cross posted
While we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered elsewhere.

Please supply all relevant links.

 

[KRIXX]

The file can only be downloaded by registered user.

To attach a file, upload it to a filesharing server, then copy the download link that you will be assigned in your next message. The simplest sharing service I know is filedropper.com

Bye

http://www.filedropper.com/transactionregister-2709

 

[KRIXX]

Cross posted
While we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered elsewhere.

Please supply all relevant links.

I have earlier started thread for this same query on Arrange System Generated Data In To User Defined Format

If I will get expected outcome of this thread there then I will mark this thread as SOLVED

 

[Fluff]

Please supply ALL links, not just one of them.

 

[KRIXX]

Sorry my mistake,

Another one is Need help to arrange unformatted data in to table format

 

[KRIXX]

Please supply ALL links, not just one of them.

I will close all other thread mentioned here if I get query resolved here

 

[KRIXX]

I will close all other thread mentioned here if I get query resolved here

And I will post the solution of the this thread If found on other thread

 

[Anthony47]

This macro is just an excercize based on similar works I did for lazy Customers:

Sub PerKRIX()
'by Anthony47, Vedi https://www.mrexcel.com/board/threads/arrange-system-generated-data-in-to-user-defined-format.1147461/#post-5566264
Dim sSh As String, dSh As String, I As Long, sNum As String
Dim LastA As Long, wArr, oArr(1 To 23), mArr, ipoDt As String
Dim iBlock As Boolean, iTxn As Boolean, VInd As Long, J As Long
'
sSh = "Sheet1"          '<<< The sheet with the "print" data
dSh = "Sheet3"          '<<< The Output sheet
'
Sheets(sSh).Select
Sheets(dSh).Range("A2:W1000").ClearContents
LastA = Cells(Rows.Count, "A").End(xlUp).Row
wArr = Range("A1").Resize(LastA, 1).Value
VInd = 2
For I = 1 To UBound(wArr)
    If Len(wArr(I, 1)) > 0 Then
        ckitm = InStr(1, wArr(I, 1), "Item:", vbTextCompare)
        If ckitm > 0 Then
            If iBlock Then
                oArr(1) = VInd - 1
                Sheets(dSh).Cells(VInd, 1).Resize(1, UBound(oArr)).Value = oArr
                If oArr(5) <> "" And oArr(7) <> "" Then VInd = VInd + 1
                Erase oArr
                iBlock = False: iTxn = False
            End If
            citm = "'" & Trim(Mid(wArr(I, 1), ckitm + 5, 15))
            oArr(1) = VInd - 1
            oArr(2) = citm
            oArr(3) = "'" & Trim(Mid(wArr(I, 1), 51, 50))
            iBlock = True
        ElseIf iBlock Then
            trow = 0
            ipoDt = Trim(Left(wArr(I, 1), 12))
            For J = 1 To 12
                cmtxt = Application.WorksheetFunction.Text(DateSerial(2000, J, 1), "[$-409]mmm")
                ipoDt = Replace(ipoDt, cmtxt, Format(J, "00"), , , vbTextCompare)
            Next J
            If IsDate(ipoDt) Then
                If iTxn Then
                    oArr(1) = VInd - 1
                    Sheets(dSh).Cells(VInd, 1).Resize(1, UBound(oArr)).Value = oArr
                    VInd = VInd + 1
    '                iBlock = False: iTxn = False
                End If
                trow = 1
                iTxn = True
            ElseIf InStr(1, wArr(I, 1), "  Txn Number:", vbTextCompare) > 0 Then
                trow = 2
            ElseIf InStr(1, wArr(I, 1), "   Locator:", vbTextCompare) > 0 Then
                oArr(20) = "'" & Trim(Replace(wArr(I, 1), "  Locator:", "", , , vbTextCompare))
            ElseIf InStr(1, wArr(I, 1), "  Category:", vbTextCompare) > 0 Then
                oArr(21) = "'" & Trim(Replace(wArr(I, 1), "  Category:", "", , , vbTextCompare))
            ElseIf InStr(1, wArr(I, 1), "  Lot Number:", vbTextCompare) > 0 Then
                oArr(22) = "'" & Trim(Replace(wArr(I, 1), "  Lot Number:", "", , , vbTextCompare))
            ElseIf InStr(1, wArr(I, 1), " Serial Num:", vbTextCompare) > 0 Then
                sNum = ""
                For J = 1 To 100
                    If Left(wArr(I + J, 1), 12) = "            " Then
                        sNum = sNum & wArr(I + J, 1)
                    Else
                        Exit For
                    End If
                Next J
                oArr(23) = "'" & Application.WorksheetFunction.Trim(sNum)
            End If
        End If
        If trow > 0 Then
            If trow = 1 Then mArr = Array(1, 12, 5, 13, 40, 7, 41, 56, 8, 58, 70, 9, 75, 85, 10, 86, 89, 11, 90, 105, 12, 106, 126, 13)
            If trow = 2 Then mArr = Array(15, 25, 14, 43, 54, 15, 71, 80, 16, 112, 124, 17)
            For J = 0 To UBound(mArr) Step 3
                oArr(mArr(J + 2)) = "'" & Trim(Mid(wArr(I, 1), mArr(J), mArr(J + 1) - mArr(J)))
            Next J
        End If
    End If
Next I
oArr(1) = VInd - 1
Sheets(dSh).Cells(VInd, 1).Resize(1, UBound(oArr)).Value = oArr
MsgBox ("Completed, maybe...")
End Sub

The lines marked <<< have to be adapted to your situation.
Put the code in a Standard Module of your Vba Project and customize the 2 lines marked <<<; then run the Sub PerKRIX

However I think you should just ask the department that create that printout to forward the information in a manageable format.

Bye