Excel Forum

Code: Select all

Option Explicit

Sub Go_Back()
    Sheets("Menu").Activate
    Range("A1").Activate
End Sub

Sub Go_Result()
    Sheets("Result1").Activate
    Range("A1").Activate
End Sub

Sub Go_Template()
    Sheets("template").Activate
    Range("A1").Activate
End Sub

Sub Clear_Data()
    Application.ScreenUpdating = False
    
    ' clear sheet template
    Sheets("result1").Activate
    Range("A2:AZ1048570").ClearContents
    Range("A2").Activate
    
    ' clear sheet2
    Sheets("ora_text").Activate
    Range("A1", Range("A1048570").End(xlUp)).ClearContents
    Application.ScreenUpdating = True
    Range("A1").Activate
    MsgBox "Past Text (edit > past spacial > text ) The Data at 'A1' ", vbOKOnly + vbInformation
   
    ' prepair for copy data to sheet2
    Sheets("ora_text").Activate
    
End Sub

Sub Process_Main()
    Dim Branch As String
    Dim CPC As String
    Dim Acc_Code As String
    Dim Sub_Acc As String
    Dim Invoice_No As String
    Dim Tran As String
    Dim Cus_Name As String
    Dim Cus_No As String
    Dim GL_Date As String
    Dim Debit_Amount1 As String
    Dim Credit_Amount1 As String
    Dim Debit_Amount2 As String
    Dim Credit_Amount2 As String
    Dim Description As String
    Dim CFS As String
     
    Dim r As Range
     
    Dim i As Integer
    
    Application.ScreenUpdating = False
    
    Sheets("result1").Activate
    Range("A2").Activate
    
    Sheets("ora_text").Activate
    
    For Each r In Range("A1", Range("A1048570").End(xlUp))
        Sheets("ora_text").Activate
        DoEvents
        
     If Mid(r.Value, 1, 21) = "Accounting Flexfield:" Then
            Branch = Trim(Mid(r.Value, 33, 6))
        End If
        
      If Mid(r.Value, 1, 21) = "Accounting Flexfield:" Then
            CPC = Trim(Mid(r.Value, 40, 5))
        End If
        
    If Mid(r.Value, 1, 21) = "Accounting Flexfield:" Then
            Acc_Code = Trim(Mid(r.Value, 46, 8))
        End If
    
    If Mid(r.Value, 1, 21) = "Accounting Flexfield:" Then
            Sub_Acc = Trim(Mid(r.Value, 55, 6))
        End If
    
    If Mid(r.Value, 81, 1) = "-" And Mid(r.Value, 82, 1) <> "-" Then
    
        Tran = Trim(Mid(r.Value, 17, 18))
        Cus_Name = Trim(Mid(r.Value, 36, 25))
        Cus_No = Trim(Mid(r.Value, 62, 16))
        GL_Date = Trim(Mid(r.Value, 79, 9))
        Debit_Amount1 = Trim(Mid(r.Value, 90, 19))
        Credit_Amount1 = Trim(Mid(r.Value, 110, 19))
        Debit_Amount2 = Trim(Mid(r.Value, 130, 19))
        Credit_Amount2 = Trim(Mid(r.Value, 150, 19))
        Description = Trim(Mid(r.Value, 170, 71))
        CFS = Trim(Mid(r.Value, 242, 15))
        
        Invoice_No = Trim(Mid(r.Value, 1, 15))
        
        'check other line is empty for next name
            For i = 1 To 1
                If Mid(r.Offset(i, 0), 81, 1) <> "-" And Mid(r.Offset(i, 0), 1, 1) <> "" Then
                   Invoice_No = Invoice_No & Trim(Mid(r.Offset(i, 0), 1, 15))
                   Description = Description & Trim(Mid(r.Offset(i, 0), 170, 71))
                   Tran = Tran & Trim(Mid(r.Offset(i, 0), 17, 18))
                   
                 Else
                   Exit For
            End If
            Next i
   
        ' ====
            Sheets("result1").Activate
           '  ---
        'ActiveCell.Value = invno
        ActiveCell.Offset(0, 1 - 1).Value = Branch
        ActiveCell.Offset(0, 2 - 1).Value = CPC
        ActiveCell.Offset(0, 3 - 1).Value = Acc_Code
        ActiveCell.Offset(0, 4 - 1).Value = Sub_Acc
        ActiveCell.Offset(0, 5 - 1).Value = Tran
        ActiveCell.Offset(0, 6 - 1).Value = Invoice_No
        ActiveCell.Offset(0, 7 - 1).Value = Cus_No
        ActiveCell.Offset(0, 8 - 1).Value = Cus_Name
        ActiveCell.Offset(0, 9 - 1).Value = GL_Date
        ActiveCell.Offset(0, 10 - 1).Value = Debit_Amount1
        ActiveCell.Offset(0, 11 - 1).Value = Credit_Amount1
        ActiveCell.Offset(0, 12 - 1).Value = Debit_Amount2
        ActiveCell.Offset(0, 13 - 1).Value = Credit_Amount2
        ActiveCell.Offset(0, 14 - 1).Value = Description
        ActiveCell.Offset(0, 15 - 1).Value = CFS
       
 ' =========
                Application.StatusBar = "Process : " + Cus_No
                ActiveCell.Offset(1, 0).Activate

        End If
              
    Next
    Sheets("result1").Activate
    'ActiveCell.Value = "END"
    '
    Call Process_Step2
    '
    Sheets("Menu").Activate
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox "Process OK"
End Sub


Sub Process_Step2()
Sheets("result1").Activate

' text to column for Account Flexfield

Range("A2").Activate

Do While Len(ActiveCell.Value) <> 0 And Len(Trim(ActiveCell.Offset(0, 3).Value)) <> 0
    If Len(Trim(ActiveCell.Value)) = 0 And Len(Trim(ActiveCell.Offset(0, 3).Value)) <> 0 Then
        ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
        ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(-1, 1).Value
    End If
    ActiveCell.Offset(1, 0).Activate
Loop

' end of text to column account Flefield

End Sub