Excel Forum

Code: Select all

Sub PullToEdit()
    Dim rFind As Range, rDataAll As Range
    Dim r As Range, rTarget As Range
    Set rFind = Sheets("Form").Range("I7")
    If Sheets("Form").Range("I7") = "" Then Exit Sub
    With Sheets("Data")
        Set rDataAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        If .Columns("A:A").Find(rFind, LookIn:=xlValues) Is Nothing Then
            MsgBox ("ไม่มีเลข PO นี้")
            Exit Sub
        End If
    End With
    For Each r In rDataAll
        If r = rFind Then
            Set rTarget = Sheets("Form").Range("B" & Rows.Count).End(xlUp) _
                .Offset(1, 0)
            r.Offset(0, 2).Resize(1, 4).Copy
            rTarget.PasteSpecial xlPasteValues
        End If
        With Sheets("Form")
            .Range("C3") = r: .Range("F3") = r.Offset(0, 1)
        End With
    Next r
    Application.CutCopyMode = False
    MsgBox "Get data has finished."
End Sub

Code: Select all

Sub PullToEdit()
    Dim rFind As Range, rDataAll As Range
    Dim r As Range, rTarget As Range
    Set rFind = Sheets("Form").Range("F4")
    If Sheets("Form").Range("F4") = "" Then Exit Sub
    With Sheets("Data")
        Set rDataAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        If .Columns("A:A").Find(rFind, LookIn:=xlValues) Is Nothing Then
            MsgBox ("äÁèÁÕàÅ¢ QO ¹Õé")
            Exit Sub
        End If
    End With
    For Each r In rDataAll
        If r = rFind Then
            Set rTarget = Sheets("Form").Range("B" & Rows.Count).End(xlUp) _
                .Offset(1, 0)
            r.Offset(0, 2).Resize(1, 3).Copy
            rTarget.PasteSpecial xlPasteValues
            With Sheets("Form")
                .Range("F3") = r.Offset(0, 1)
            End With
        End If
    Next r
    Application.CutCopyMode = False
    MsgBox "Get data has finished."
End Sub

Code: Select all

Sub PullToEdit()
    Dim rFind As Range, rDataAll As Range
    Dim r As Range, rTarget As Range
    Set rFind = Sheets("Form").Range("F4")
    If Sheets("Form").Range("F4") = "" Then Exit Sub
    With Sheets("Data")
        Set rDataAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        If .Columns("A:A").Find(rFind, LookIn:=xlValues) Is Nothing Then
            MsgBox ("äÁèÁÕàÅ¢ QO ¹Õé")
            Exit Sub
        End If
    End With
    For Each r In rDataAll
        If r = rFind Then
            Set rTarget = Sheets("Form").Range("B" & Rows.Count).End(xlUp) _
                .Offset(1, 0)
            r.Offset(0, 2).Resize(1, 3).Copy
            rTarget.PasteSpecial xlPasteValues
            With Sheets("Form")
                .Range("F3") = r.Offset(0, 1)
            End With
        End If
    Next r
    Application.CutCopyMode = False
    MsgBox "Get data has finished."
End Sub

Code: Select all

Private Sub CommandButton1_Click()
    Dim rFind As Range, rDataAll As Range
    Dim r As Range, rTarget As Range
    Dim irow As Long
    Dim ws As Worksheet
    Sheets("PurchaseOrder").Unprotect Password:="240130" '<==UnProtect
    Set ws = Worksheets("PurchaseOrder")
    'find first empty row in database
    irow = ws.Cells("8") _
        .End(xlUp).Range("H10").Row
    'Check for Id
    If Trim(Me.TextBox1.Value) = "" Then
        Me.TextBox1.SetFocus
        MsgBox "เลือกหน่วยงาน"
        Exit Sub
    End If
    'copy the data to the database
    ws.Cells(irow, 8).Value = Me.TextBox1.Value
    
    'Clear the data
    Me.TextBox1.Value = ""
    Me.TextBox1.SetFocus
    
    Set rFind = Sheets("PurchaseOrder").Range("H10")
        If Sheets("PurchaseOrder").Range("H10") = "" Then Exit Sub
        With Sheets("Data")
            Set rDataAll = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
            If .Columns("B:B").Find(rFind, LookIn:=xlValues) Is Nothing Then
                MsgBox ("ไม่มีเลขที่ QO นี้")
                Exit Sub
            End If
        End With
        For Each r In rDataAll
            If r = rFind Then
                Set rTarget = Sheets("PurchaseOrder").Range("B" & Rows.Count).End(xlUp) _
                    .Offset(1, 0)
                rTarget = r.Offset(0, 1)
                rTarget.Offset(0, 1) = r.Offset(0, 2)
                rTarget.Offset(0, 5) = r.Offset(0, 3)
                rTarget.Offset(0, 6) = r.Offset(0, 4)
                With Sheets("PurchaseOrder")
                    .Range("I13") = r ': .Range("C7") = r.Offset(0, 1)
                End With
            End If
        Next r
        Application.CutCopyMode = False
        MsgBox "Get data has finished."
        Sheets("PurchaseOrder").Select
    If Sheets("PurchaseOrder").Select Then
    UserForm6.Hide
    End If
    Sheets("PurchaseOrder").Protect Password:="240130" '<== Protect Again
End Sub