79602402

Date: 2025-05-01 19:01:21
Score: 0.5
Natty:
Report link

I am giving the code that works very well. Thank you Michal for your help.

Sub SplitLines()
    Dim ws As Worksheet
    Dim lines As Variant, parts As Variant
    Dim lineText As String, amountText As String, dateText As String, mixText as String
    Dim firstRow As Long, lastRow As Long
    Dim r As Long, i As Long, numLines As Long

    Set ws = ActiveSheet
    firstRow = ActiveCell.Row
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    For r = lastRow To firstRow Step -1
        If ws.Cells(r, "A").Value <> "" Then
            lines = Split(ws.Cells(r, "A").Value, vbLf)
            numLines = UBound(lines) - LBound(lines) + 1
            If numLines > 1 Then
                ws.Rows(r + 1 & ":" & r + numLines - 1).Insert Shift:=xlShiftDown
            End If
            For i = LBound(lines) To UBound(lines)
                lineText = Trim(lines(i))
                lineText = Application.Trim(lineText)
                parts = Split(lineText, " ")
                If UBound(parts) >= 1 Then
                    amountText = parts(0)
                    dateText = parts(1)
                Else
                mixText = parts(0)
                    If Len(mixText) = 10 Then
                        amountText = ""
                        dateText = LineText
                    Else
                        amountText = LineText
                        dateText = ""
                    End If
                 End If

                If amountText <> "" Then ws.Cells(r + i, "C").Value = CCur(amountText)
                If dateText <> "" Then ws.Cells(r + i, "D").Value = CDate(dateText)

            Next i
        End If
    Next r

    ws.Columns("C").NumberFormat = "#,##0.00 zł"
    ws.Columns("D").NumberFormat = "dd/mm/yyyy"
End Sub
Reasons:
  • Blacklisted phrase (0.5): Thank you
  • Long answer (-1):
  • Has code block (-0.5):
  • Self-answer (0.5):
  • Low reputation (1):
Posted by: Grzegorz