Excel Forum

Code: Select all

Option Explicit
Dim db As Worksheet
Dim ws As Worksheet
Dim objWorkbook As Workbook

Private Sub cmd_save_Click()
      
            Set objWorkbook = Workbooks.Open("D:\ระบบงานออฟฟิศ\database.xlsm")
            Set db = objWorkbook.Sheets("tbl_supplier")
            Set ws = Workbooks("center.xlsm").Worksheets("temp_sup")
            
            With Application
                .DisplayAlerts = False
                .ScreenUpdating = False
            End With
                       
            Dim rsAll As Range, rtAll As Range
            Dim rs As Range, i As Integer
            If Me.txt_name <> "" Then
                Set rsAll = ws.Range("A13:K13")
                Set rtAll = db.Range("A2", db.Range("A" & Rows.Count).End(xlUp))
        
            For Each rs In rsAll
                For i = rtAll.Count To 1 Step -1
                    If rs = rtAll(i) And rs.Offset(0, 0) = rtAll(i).Offset(0, 0) Then
                        rs.Offset(0, 1).Resize(1, 10).Copy
                        rtAll(i).Offset(0, 1).PasteSpecial xlPasteValues
                        Application.CutCopyMode = False
                        MsgBox ("อัพเดทข้อมูลเรียบร้อยแล้ว")
                        ws.Range("C17:K17").ClearContents
                    End If
                Next i
            Next rs
            Else
            MsgBox "คุณยังไม่ระบุชื่อบุคคล", vbCritical
            End If
            
            objWorkbook.Close True
            With Application
                .DisplayAlerts = True
                .ScreenUpdating = True
            End With
                 
End Sub

Code: Select all

Dim rsAll As Range, rtAll As Range
            Dim rs As Range, i As Integer
            With ws
                Set rsAll = .Range("A13")
                Set rs = .Range("A13:A13")
            End With
            With db
                Set rtAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            End With
            With ws
                            For Each rs In rsAll
                            For i = rtAll.Count To 1 Step -1
                                If rs = rtAll(i) And rs.Offset(0, 0) = rtAll(i).Offset(0, 0) Then
                                    rs.Offset(0, 1).Resize(1, 10).Copy
                                    rtAll(i).Offset(0, 1).PasteSpecial xlPasteValues
                                    Application.CutCopyMode = False
                                    MsgBox ("อัพเดทข้อมูลเรียบร้อยแล้ว")
                                End If
                Next i
            Next rs
            End With

Code: Select all

Option Explicit

Sub cmd_save()
    Dim rsAll As Range, rtAll As Range
    Dim rs As Range, i As Integer
    Dim db As Worksheet
    Dim ws As Worksheet
    Dim objWorkbook As Workbook
    Dim rowNum As Integer
    
    Set objWorkbook = Workbooks.Open("D:\ระบบงานออฟฟิศ\database.xlsx")
    Set db = objWorkbook.Sheets("tbl_supplier")
    Set ws = Workbooks("center.xlsm").Worksheets("temp_sup")
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
               
    With ws
        Set rsAll = .Range("A13:A13")
    End With
    With db
        Set rtAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With
    For Each rs In rsAll
        With Application
            If .CountIf(rtAll, rs) > 0 Then
                rowNum = .Match(rs, rtAll, 0)
                rtAll(rowNum).Offset(0, 1).Resize(1, 10) = rs.Offset(0, 1).Resize(1, 10).Value
            End If
        End With
    Next rs
    
    objWorkbook.Close True
    
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    MsgBox "Your records updated"
End Sub

Code: Select all

Private Sub cmd_save_Click()
        Unload Me
       Call saveup
       frm_sup_up.show
End Sub