Snasui Excel Forum

Code: Select all

Sub ArBilling()
    Dim formBook As Workbook
    Dim wbShare As Workbook
    Dim wb As Workbook ' declare wb as workbook
    Dim wdShare As Workbook
    Dim wdShareOpen As Boolean
    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range
    Dim rt As Range
    Dim i As Double
    Set formBook = ThisWorkbook
    Set wbShare = Workbooks("ArBillBookShare.xlsx")
    For Each wb In Workbooks ' loop wb not loop wdShare
        If wb.Name = "PoWbShare.xlsx" Then
            wdShareOpen = True
        End If
    Next wb
    If Not wdShareOpen Then
    End If
    Set wdShare = Workbooks("PoWbShare.xlsx") 'set wdShare after open not before open
    With formBook.Sheets("Form")
        Set rSource = .Range("B3:B50")
    End With
    With wdShare.Sheets("Sheet1")
        Set rTarget = .Range("E2", .Range("E" & Rows.Count).End(xlUp))
    End With
    With formBook.Sheets("Form")
        i = (.Range("P9") + .Range("M12"))
        If i <> .Range("J12") Then
            MsgBox "â»Ã´µÃǨ¨Ó¹Ç¹à§Ô¹áÅкѹ·Ö¡ãËÁè"
            Exit Sub
        End If
    End With
    Application.Calculation = xlCalculationManual
    For Each rs In rSource
        For Each rt In rTarget
            If rt = rs Then rt.Offset(0, 26) = "Y"
        Next rt
    Next rs
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    With formBook.Sheets("TemBilling")
    .Range("A2:O2").Resize(.Range("P1")).Copy
    End With
    wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    formBook.Sheets("Form").Range("H1,J4:O8,M12").ClearContents
    With formBook.Sheets("Form")
        .Range("i4") = .Range("i4") + 1
    End With
    Application.ScreenUpdating = True
        wbShare.Save
        wdShare.Save
        formBook.Save
        Range("H1").Select
End Sub

Code: Select all

If Not Intersect(Target, Range("H1")) Is Nothing Then
    Worksheets("Suppliers").Range("P1") = Target
    Target.Select
    If Len(Target) < 3 Then
        Application.SendKeys "%{DOWN}"
    End If
End If

Code: Select all

If Len(Target) < 3 Then
    Application.SendKeys "%{DOWN}"
End If

Code: Select all

Range("H1").Select
    ActiveCell.FormulaR1C1 = "เอ"

Code: Select all

If Sheets("Form").Range("H1") <> "" Then
End If

Code: Select all

Sub MainCode()
Call Workbook_SheetChange
Call ArBilling
End Sub

Code: Select all

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
      If Sheets("Form").Range("H1") <> "" Then
      End If
End Sub

Code: Select all

Sub ArBilling()
    Dim formBook As Workbook
    Dim wbShare As Workbook
    Dim wb As Workbook ' declare wb as workbook
    Dim wdShare As Workbook
    Dim wdShareOpen As Boolean
    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range
    Dim rt As Range
    Dim i As Double
    Set formBook = ThisWorkbook
    Set wbShare = Workbooks("ArBillBookShare.xlsx")
    For Each wb In Workbooks ' loop wb not loop wdShare
        If wb.Name = "PoWbShare.xlsx" Then
            wdShareOpen = True
        End If
    Next wb
    If Not wdShareOpen Then
    End If
    Set wdShare = Workbooks("PoWbShare.xlsx") 'set wdShare after open not before open
    With formBook.Sheets("Form")
        Set rSource = .Range("B3:B50")
    End With
    With wdShare.Sheets("Sheet1")
        Set rTarget = .Range("E2", .Range("E" & Rows.Count).End(xlUp))
    End With
    With formBook.Sheets("Form")
        i = (.Range("P9") + .Range("M12"))
        If i <> .Range("J12") Then
            MsgBox "â»Ã´µÃǨ¨Ó¹Ç¹à§Ô¹áÅкѹ·Ö¡ãËÁè"
            Exit Sub
        End If
    End With
    Application.Calculation = xlCalculationManual
    For Each rs In rSource
        For Each rt In rTarget
            If rt = rs Then rt.Offset(0, 26) = "Y"
        Next rt
    Next rs
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    With formBook.Sheets("TemBilling")
    .Range("A2:O2").Resize(.Range("P1")).Copy
    End With
    wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    formBook.Sheets("Form").Range("H1,J4:O8,M12").ClearContents
    With formBook.Sheets("Form")
        .Range("i4") = .Range("i4") + 1
    End With
    Application.ScreenUpdating = True
        wbShare.Save
        wdShare.Save
        formBook.Save
        Range("H1").Select
End Sub