macro to skin details of inventory from TALLY SOFTWARE

[makinmomb]

Find attached my file , it is an extract from TALLY SOFTWARE
see column A to H going down to 2o,ooo rows

I need the data see results on J to O that i have manually done for two invoices

I want the macro do me the task

[Artik]

Such slightly twisted macro.

Sub ListInvoices()
    Dim lRow        As Long
    Dim strFirstAddress As String
    Dim vResult     As Variant
    Dim SalsCount   As Long
    Dim rngSal1     As Range
    Dim rngSalNxt   As Range
    Dim i           As Long
    Dim k           As Long
    Dim vDataTmp    As Variant


    lRow = Cells(Rows.Count, "E").End(xlUp).Row
    SalsCount = Application.CountIf(Columns("E").Cells, "Sales")

    ReDim vResult(1 To lRow - SalsCount * 2, 1 To 6)

    With Range("D1:E" & lRow)
        Set rngSal1 = .Find(What:="Sales", _
                            After:=Range("D1"), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False, _
                            SearchFormat:=False)


        If Not rngSal1 Is Nothing Then
            k = 1


            strFirstAddress = rngSal1.Address

            Set rngSalNxt = .FindNext(rngSal1)

            If rngSalNxt.Address = strFirstAddress Then
                Set rngSalNxt = Cells(lRow + 1, "E")
            End If

            Do

                vDataTmp = Range(Cells(rngSal1.Row, 1), Cells(rngSalNxt.Row - 1, 6)).Value

                For i = 3 To UBound(vDataTmp)
                    vResult(k, 1) = vDataTmp(1, 1)
                    vResult(k, 2) = vDataTmp(i, 2)
                    vResult(k, 3) = vDataTmp(i, 3)
                    vResult(k, 4) = vDataTmp(i, 4)
                    vResult(k, 5) = vDataTmp(1, 6)
                    vResult(k, 6) = vDataTmp(1, 2)
                    k = k + 1
                Next i

                Set rngSal1 = rngSalNxt

                On Error Resume Next
                Set rngSalNxt = .FindNext(rngSalNxt)
                If Err.Number <> 0 Then
                    On Error GoTo 0
                    Exit Do
                End If

                If rngSalNxt.Address = strFirstAddress Then
                    Set rngSalNxt = Cells(lRow + 1, "E")
                End If

            Loop Until strFirstAddress = rngSalNxt.Address

        End If

    End With


    If Not IsEmpty(Range("J3").Value) Then
        Range("J3").CurrentRegion.Clear
    End If

    With Range("J3").Resize(UBound(vResult), UBound(vResult, 2))
        .Columns(1).NumberFormat = "dd-mmm-yy"
        .Columns(3).NumberFormat = "0.00"" CTN"""
        .Columns(4).NumberFormat = "0""/CTN"""

        .Value = vResult
    End With

End Sub

Artik

[Sintek]

Another Option...
I notice the two different formats CTN and PCS...
Is only (24 in Col C) formatted as PCS

Sub J3v16()
Dim Data, Temp, Dt As String, Acc As String, Valu As String, i As Long, ii As Long, x As Long
With Cells(1).CurrentRegion
    Data = .Value: ReDim Temp(1 To Application.Count(.Columns(4)), 1 To 6)
    For i = 1 To UBound(Data)
        If Data(i, 1) <> "" Then Dt = Format(Data(i, 1), "DD-MMM-YY"): Acc = Data(i, 2): Valu = Data(i, 6)
        If Data(i, 3) <> "" Then
            x = x + 1
            Temp(x, 1) = Dt: Temp(x, 6) = Acc: Temp(x, 5) = Valu
            For ii = 1 To 3
                Temp(x, ii + 1) = IIf(ii = 2, IIf(Data(i, ii + 1) = 24, Format(Data(i, ii + 1), "0.00 ""PCS"""), Format(Data(i, ii + 1), "0.00 ""CTN""")), IIf(ii = 3, IIf(Data(i, ii) = 24, Format(Data(i, ii + 1), "0""/PCS"""), Format(Data(i, ii + 1), "0""/CTN""")), Data(i, ii + 1)))
            Next ii
        End If
    Next i
   .Offset(, 9).Resize(x, 6).Value = Temp
End With
End Sub

[Artik]

I notice the two different formats CTN and PCS...

Oops, actually, I didn't notice it.

I allowed myself to fix the sintek code (it is more understandable than mine) because in the results:
1. I have not received the date in the source format,
2. Values in the third and fourth columns are not numbers.
3. The correct conversion to CTN or PCS occurred only for the specified value (24).

Sub J3v16_A()
    Dim Data, Temp, Valu
    Dim Dt As Date, Acc As String
    Dim i As Long, ii As Long, x As Long
    Dim TmpFormat   As Variant


    With Cells(1).CurrentRegion
        Data = .Value

        ReDim Temp(1 To Application.Count(.Columns(4)), 1 To 6)
        ReDim TmpFormat(1 To UBound(Temp), 1 To 2)

        For i = 1 To UBound(Data)
            
            If Data(i, 1) <> "" Then
                Dt = Data(i, 1)
                Acc = Data(i, 2)
                Valu = Data(i, 6)
            End If


            If Data(i, 3) <> "" Then
                x = x + 1
                
                Temp(x, 1) = Dt
                Temp(x, 6) = Acc
                Temp(x, 5) = Valu

                For ii = 1 To 3
                    Temp(x, ii + 1) = Data(i, ii + 1)
                    If ii > 1 Then
                        TmpFormat(x, ii - 1) = Cells(i, ii + 1).NumberFormat
                    End If
                Next ii
            End If
            
        Next i


        With .Offset(, 10).Resize(x, 6)
            .Columns(1).NumberFormat = "dd-mmm-yy"
            .Value = Temp
            For i = 1 To UBound(TmpFormat)
                .Cells(i, 3).NumberFormat = TmpFormat(i, 1)
                .Cells(i, 4).NumberFormat = TmpFormat(i, 2)
            Next i
        End With
        
    End With

End Sub

Ad.1
Format of my short system date (in Windows) is "dd.mm.yyyy".
When I use

Dim Dt As String
(...)
Dt = Format(Data(i, 1), "DD-MMM-YY")

in the result area I will get the text, not the date. For example "01-kwi-21" for date 1 April 2021. Only March is an exception as the first 3 letters match

MsgBox Left("Marzec", 3) = Left("March", 3)

But I get dates in the format "dd.mmm.yy" (eg 01.mar.21) instead of "dd-mmm-yy" (01-mar-21).
These are localization problems in Europe where a language other than English is used (not only in Poland). We deal with this problem on a daily basis, so we must pay attention to it.

Artik

[makinmomb]

Thank you artic , wow , it skinned all the details i needed from 3ooo rows and saved me so much time