Snasui Excel Forum

Code: Select all

Private Sub CmdInsertRow_Click()
    Dim i As Integer, j As Integer
    Dim rAll As Range, r As Range
    With Sheets("bis225")
        Set rAll = .Range("D1", .Range("D" & Rows.Count).End(xlUp))
    End With
    For Each r In rAll
           If r.Value = r.Offset(1, 0).Value Then
                  'your code
           Else
                  'your code
                  'r.EntireRow.Insert
           End If
    Next r
End Sub

Code: Select all

Private Sub CmdAddInv_Click()
    Dim i As Integer, j As Integer
    Dim rAll As Range, r As Range
    With Sheets("bis225")
        Set rAll = .Range("D1", .Range("D" & Rows.Count).End(xlUp))
    End With
    i = LstPoc.ListCount
    For Each r In rAll
        For j = 0 To i - 1
            If r = LstPoc.List(j) Then
                r = TxtInv.Value
            End If
        Next j
    Next r
End Sub

Code: Select all

Private Sub CmdAddInv_Click()
If Application.Range("D1:D") = LstPoc.Value Then
Cells(WriteRow, 4) = TxtInv.Value
End If
End Sub

Private Sub CmdConvrt_Click()
Dim Handle As Integer, File_Name As String
Dim WriteRow As Long, TemArr, OneLine As String
Dim Price1, Price2, Price3 As Integer
Dim Pono() As Variant
Dim Invno() As String
Dim Chkval As Integer
Price1 = 1
Price2 = 2
Price3 = 3
Handle = FreeFile
File_Name = "D:\testrun.txt"
Open File_Name For Input As #Handle
Application.Range("A1:z999") = ""
LstPoa.Value = Null
Do While Not EOF(Handle)
    Line Input #Handle, OneLine
    TemArr = Split(OneLine, "|")
    If UBound(TemArr) > 1 Then
        WriteRow = WriteRow + 1
        Cells(WriteRow, 1) = "VMI050"
        Cells(WriteRow, 2) = TemArr(1)
        Cells(WriteRow, 3) = TemArr(2)
        Cells(WriteRow, 4) = TemArr(4)
        If TemArr(4) = 9999999999# Then
        Cells(WriteRow, 4) = 999999999999999#
        End If
        If TemArr(4) = 9999999999# Then
        TemArr(4) = ""
        Else
        LstPoa.AddItem (TemArr(4))
        End If
        Cells(WriteRow, 5) = TemArr(5)
        Cells(WriteRow, 6) = TemArr(5)
        Cells(WriteRow, 7) = TemArr(7)
        Cells(WriteRow, 8) = TemArr(8)
        Cells(WriteRow, 9) = "   PC"
        If TemArr(4) = 9999999999# Then
        Cells(WriteRow, 9) = "     "
        Cells(WriteRow, 11).Value = Application.Sum(Range("K1:K" & WriteRow))
        End If
        If TemArr(29) = "S225-1-1011-001" Then
        'Cells(WriteRow, 10) = Txtprc1.Value
        'Cells(WriteRow, 11) = TemArr(8) * Txtprc1
        Cells(WriteRow, 10) = Price1
        Cells(WriteRow, 11) = TemArr(8) * Price1
        ElseIf TemArr(29) = "S225-1-1211-002" Then
        Cells(WriteRow, 10) = Price2
        Cells(WriteRow, 11) = TemArr(8) * Price2
        ElseIf TemArr(29) = "S225-1-DUMM-001" Then
        Cells(WriteRow, 10) = Price3
        Cells(WriteRow, 11) = TemArr(8) * Price3
        End If
        Cells(WriteRow, 12) = TemArr(9)
        Cells(WriteRow, 13) = TemArr(24)
        Cells(WriteRow, 14) = TemArr(25)
        Cells(WriteRow, 15) = TemArr(26)
    End If
Loop
Close #Handle
End Sub

Private Sub CmdMove_Click()
LstPoc.AddItem (LstPoa.Value)
End Sub

Private Sub CmdSavefiles_Click()
    ChDir "D:\"
    ActiveWorkbook.SaveAs Filename:="D:\testfile.txt", FileFormat:=xlTextMSDOS, _
        CreateBackup:=False
End Sub

Private Sub Txtprc1_Change()
   If Me.Txtprc1.Value = "" Then Exit Sub
   On Error Resume Next
    With Me.Txtprc1
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Private Sub Txtprc2_Change()
    If Me.Txtprc2.Value = "" Then Exit Sub
    On Error Resume Next
    With Me.Txtprc2
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Private Sub Txtprc3_Change()
    If Me.Txtprc3.Value = "" Then Exit Sub
    On Error Resume Next
    With Me.Txtprc3
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

End Sub

Private Sub LstPoa_Click()

End Sub

Code: Select all

Private Sub CmdConvrt_Click()
Dim Handle As Integer, File_Name As String
Dim WriteRow As Long, TemArr, OneLine As String
Dim Price1, Price2, Price3 As String
Dim Pono() As Variant
Dim Invno() As String
Dim Chkval As Integer
Handle = FreeFile
File_Name = "D:\testrun.txt"
Open File_Name For Input As #Handle
Application.Range("A1:z999") = ""
ListBox1.Value = Null
Do While Not EOF(Handle)
    Line Input #Handle, OneLine
    TemArr = Split(OneLine, "|")
    If UBound(TemArr) > 1 Then
        WriteRow = WriteRow + 1
        Cells(WriteRow, 1) = "VMI050"
        Cells(WriteRow, 2) = TemArr(1)
        Cells(WriteRow, 3) = TemArr(2)
        Cells(WriteRow, 4) = TemArr(4)
        ListBox1.AddItem (TemArr(4))
        ComboBox1.AddItem (TemArr(4))
        Cells(WriteRow, 5) = TemArr(5)
        Cells(WriteRow, 6) = TemArr(5)
        Cells(WriteRow, 7) = TemArr(7)
        Cells(WriteRow, 8) = TemArr(8)
        Cells(WriteRow, 9) = "   PC"
        If TemArr(4) = 9999999999# Then
        Cells(WriteRow, 9) = "     "
        Cells(WriteRow, 11).Value = Application.Sum(Range("K1:K" & WriteRow))
        End If
        If TemArr(29) = "S225-1-1011-001" Then
        Cells(WriteRow, 10) = Txtprc1.Value
        Cells(WriteRow, 11) = TemArr(8) * Txtprc1
        ElseIf TemArr(29) = "S225-1-1211-002" Then
        Cells(WriteRow, 10) = Txtprc2.Value
        Cells(WriteRow, 11) = TemArr(8) * Txtprc2
        ElseIf TemArr(29) = "S225-1-DUMM-001" Then
        Cells(WriteRow, 10) = Txtprc3.Value
        Cells(WriteRow, 11) = TemArr(8) * Txtprc3
        End If
        Cells(WriteRow, 12) = TemArr(9)
        Cells(WriteRow, 13) = TemArr(24)
        Cells(WriteRow, 14) = TemArr(25)
        Cells(WriteRow, 15) = TemArr(26)
    End If
Loop
Close #Handle
End Sub

Private Sub CmdSavefiles_Click()
    ChDir "D:\"
    ActiveWorkbook.SaveAs Filename:="D:\testfile.txt", FileFormat:=xlTextMSDOS, _
        CreateBackup:=False
End Sub

Private Sub RefEdit1_BeforeDragOver(Cancel As Boolean, ByVal Data As MSForms.DataObject, ByVal x As stdole.OLE_XPOS_CONTAINER, ByVal y As stdole.OLE_YPOS_CONTAINER, ByVal DragState As MSForms.fmDragState, Effect As MSForms.fmDropEffect, ByVal Shift As Integer)

End Sub



Private Sub ListBox1_Click()

End Sub

Private Sub ScrollBar1_Change()

End Sub

Private Sub Txtprc1_Change()
   If Me.Txtprc1.Value = "" Then Exit Sub
   On Error Resume Next
    With Me.Txtprc1
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Private Sub Txtprc2_Change()
    If Me.Txtprc2.Value = "" Then Exit Sub
    On Error Resume Next
    With Me.Txtprc2
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Private Sub Txtprc3_Change()
    If Me.Txtprc3.Value = "" Then Exit Sub
    On Error Resume Next
    With Me.Txtprc3
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Code: Select all

Private Sub CmdConvrt_Click()
    Dim Handle As Integer, File_Name As String
    Dim WriteRow As Long, TemArr, OneLine As String
    Dim Price1, Price2, Price3 As String
    Dim Pono() As Variant
    Dim Invno() As String
    Dim Chkval As Integer
    Dim Sump1 As Integer
    Dim Sump2 As Integer
    Dim Sump3 As Integer
    Dim Sumpr As Integer
    Dim Sumprice As Integer
    Handle = FreeFile
    File_Name = "D:\testrun.txt"
    Open File_Name For Input As #Handle
    Do While Not EOF(Handle)
        Line Input #Handle, OneLine
        TemArr = Split(OneLine, "|")
        If UBound(TemArr) > 1 Then
            WriteRow = WriteRow + 1
            Cells(WriteRow, 1) = "VMI050"
            Cells(WriteRow, 2) = TemArr(1)
            Cells(WriteRow, 3) = TemArr(2)
            'Pono = TemArr(4)
            Cells(WriteRow, 4) = TemArr(4)
            Cells(WriteRow, 5) = TemArr(5)
            Cells(WriteRow, 6) = TemArr(5)
            Cells(WriteRow, 7) = TemArr(7)
            Cells(WriteRow, 8) = TemArr(8)
            Cells(WriteRow, 9) = "   PC"
            If TemArr(4) = 9999999999# Then
                Cells(WriteRow, 9) = "     "
                Cells(WriteRow, 11).Value = Application.Sum( _
                    Range("K1:K" & WriteRow))
            End If
            If TemArr(29) = "S225-1-1011-001" Then
                Cells(WriteRow, 10) = Txtprc1.Value
                Cells(WriteRow, 11) = TemArr(8) * Txtprc1
                Sump1 = Cells(WriteRow, 11)
            ElseIf TemArr(29) = "S225-1-1211-002" Then
                Cells(WriteRow, 10) = Txtprc2.Value
                Cells(WriteRow, 11) = TemArr(8) * Txtprc2
                Sump2 = Cells(WriteRow, 11)
            ElseIf TemArr(29) = "S225-1-DUMM-001" Then
                Cells(WriteRow, 10) = Txtprc3.Value
                Cells(WriteRow, 11) = TemArr(8) * Txtprc3
                Sump3 = Cells(WriteRow, 11)
            End If
            'Cells(WriteRow, 11) = TemArr(8) * DC
            Cells(WriteRow, 12) = TemArr(9)
            Cells(WriteRow, 13) = TemArr(24)
            Cells(WriteRow, 14) = TemArr(25)
            Cells(WriteRow, 15) = TemArr(26)
            Sumpr = Sump1 + Sump2 + Sump3
            'Sumprice = Sumpr + Sumprice
            'Sumprice = Sumprice + Sumpr
        End If
        'Sumprice = Sumprice + Sumpr
    Loop
    Close #Handle
End Sub

Code: Select all

Private Sub CmdConvrt_Click()
Dim Handle As Integer, File_Name As String
Dim WriteRow As Long, TemArr, OneLine As String
Dim Price1, Price2, Price3 As String
Dim Pono() As Variant
Dim Invno() As String
Dim Chkval As Integer
Dim Sump1 As Integer
Dim Sump2 As Integer
Dim Sump3 As Integer
Dim Sumpr As Integer
Dim Sumprice As Integer
Handle = FreeFile
File_Name = "D:\testrun.txt"
Open File_Name For Input As #Handle
Do While Not EOF(Handle)
    Line Input #Handle, OneLine
    TemArr = Split(OneLine, "|")
    If UBound(TemArr) > 1 Then
        WriteRow = WriteRow + 1
        Cells(WriteRow, 1) = "VMI050"
        Cells(WriteRow, 2) = TemArr(1)
        Cells(WriteRow, 3) = TemArr(2)
        'Pono = TemArr(4)
        Cells(WriteRow, 4) = TemArr(4)
        Cells(WriteRow, 5) = TemArr(5)
        Cells(WriteRow, 6) = TemArr(5)
        Cells(WriteRow, 7) = TemArr(7)
        Cells(WriteRow, 8) = TemArr(8)
        Cells(WriteRow, 9) = "   PC"
        If TemArr(4) = 9999999999# Then
        Cells(WriteRow, 9) = "     "
        Cells(WriteRow, 11) = Sumprice
        End If
        If TemArr(29) = "S225-1-1011-001" Then
        Cells(WriteRow, 10) = Txtprc1.Value
        Cells(WriteRow, 11) = TemArr(8) * Txtprc1
        Sump1 = Cells(WriteRow, 11)
        ElseIf TemArr(29) = "S225-1-1211-002" Then
        Cells(WriteRow, 10) = Txtprc2.Value
        Cells(WriteRow, 11) = TemArr(8) * Txtprc2
        Sump2 = Cells(WriteRow, 11)
        ElseIf TemArr(29) = "S225-1-DUMM-001" Then
        Cells(WriteRow, 10) = Txtprc3.Value
        Cells(WriteRow, 11) = TemArr(8) * Txtprc3
        Sump3 = Cells(WriteRow, 11)
        End If
        'Cells(WriteRow, 11) = TemArr(8) * DC
        Cells(WriteRow, 12) = TemArr(9)
        Cells(WriteRow, 13) = TemArr(24)
        Cells(WriteRow, 14) = TemArr(25)
        Cells(WriteRow, 15) = TemArr(26)
        Sumpr = Sump1 + Sump2 + Sump3
        'Sumprice = Sumpr + Sumprice
        'Sumprice = Sumprice + Sumpr
    End If
    'Sumprice = Sumprice + Sumpr
Loop
Close #Handle
End Sub

Private Sub CmdSavefiles_Click()
    ActiveWorkbook.SaveAs Filename:= _
        "D:\testfile.txt", FileFormat:= _
        xlTextMSDOS, CreateBackup:=False
End Sub

Private Sub RefEdit1_BeforeDragOver(Cancel As Boolean, ByVal Data As MSForms.DataObject, ByVal x As stdole.OLE_XPOS_CONTAINER, ByVal y As stdole.OLE_YPOS_CONTAINER, ByVal DragState As MSForms.fmDragState, Effect As MSForms.fmDropEffect, ByVal Shift As Integer)

End Sub

Private Sub Txtprc1_Change()
   If Me.Txtprc1.Value = "" Then Exit Sub
   On Error Resume Next
    With Me.Txtprc1
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Private Sub Txtprc2_Change()
    If Me.Txtprc2.Value = "" Then Exit Sub
    On Error Resume Next
    With Me.Txtprc2
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Private Sub Txtprc3_Change()
    If Me.Txtprc3.Value = "" Then Exit Sub
    On Error Resume Next
    With Me.Txtprc3
        Chkval = Evaluate(.Value)
        If Left(Chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Code: Select all

Private Sub Txtprc1_Change()
   If Me.Txtprc1.Value = "" Then Exit Sub
   On Error Resume Next
    With Me.Txtprc1
        chkval = Evaluate(.Value)
        If Left(chkval, 5) = "Error" Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Code: Select all

Private Sub Txtprc1_Change()
    If Me.Txtprc1.Value = "" Then Exit Sub
    With Me.Txtprc1
        If Not Right(.Text, 1) Like "#" And Right(.Text, 1) <> "." Then
            MsgBox (" Input only number.")
            .Value = Left(.Value, Len(.Value) - 1)
        End If
    End With
End Sub

Code: Select all

Private Sub CmdConvrt_Click()
Dim Handle As Integer, File_Name As String
Dim WriteRow As Long, TemArr, OneLine As String
Dim price1, price2, price3 As String
Handle = FreeFile
File_Name = "D:\Testrun.txt"
Open File_Name For Input As #Handle
Do While Not EOF(Handle)
Line Input #Handle, OneLine
TemArr = Split(OneLine, "|")
If UBound(TemArr) > 1 Then
WriteRow = WriteRow + 1
Cells(WriteRow, 1) = TemArr(0)
Cells(WriteRow, 2) = TemArr(1)
Cells(WriteRow, 3) = TemArr(2)
Cells(WriteRow, 4) = TemArr(4)
Cells(WriteRow, 5) = TemArr(5)
Cells(WriteRow, 6) = TemArr(5)
Cells(WriteRow, 7) = TemArr(7)
Cells(WriteRow, 8) = TemArr(8)
Cells(WriteRow, 9) = TemArr(9)
If TemArr(29) = "S225-1-1011-001" Then
Cells(WriteRow, 10) = Txtprc1.Value
Cells(WriteRow, 11) = TemArr(8) * Txtprc1
ElseIf TemArr(29) = "S225-1-1211-002" Then
Cells(WriteRow, 10) = Txtprc2.Value
Cells(WriteRow, 11) = TemArr(8) * Txtprc2
ElseIf TemArr(29) = "S225-1-DUMM-001" Then
Cells(WriteRow, 10) = Txtprc3.Value
Cells(WriteRow, 11) = TemArr(8) * Txtprc3
End If
'Cells(WriteRow, 11) = TemArr(8) * DC
Cells(WriteRow, 12) = TemArr(9)
Cells(WriteRow, 13) = TemArr(24)
Cells(WriteRow, 14) = TemArr(25)
Cells(WriteRow, 15) = TemArr(26)
End If
Loop
Close #Handle
End Sub

Code: Select all

Private Sub Txtprc1_Change()
    If Me.Txtprc1.Value = "" Then Exit Sub
    With Me.Txtprc1
        If Not .Text Like "#" Then
            MsgBox (" Input only number.")
            .Value = ""
        End If
    End With
End Sub