Excel Forum

Code: Select all

Option Explicit
Dim k As Integer
Dim r As Integer

Private Sub CommandButton1_Click()
    r = 5
    For k = 2 To 5
    
'1010000000  KKK00
    If Sheet2.Cells(k, 5) <> "" And Sheet2.Cells(k, 2) = "GOODS" And Sheet2.Cells(k, 4) = "THB" Then
        Sheet1.Cells(5, 3) = Sheet2.Cells(k, 5)
    End If
    
    If Sheet2.Cells(k, 5) <> "" And Sheet2.Cells(k, 2) = "GOODS" And Sheet2.Cells(k, 4) = "JPY" Then
            Sheet1.Cells(6, 3) = Sheet2.Cells(k, 5)
            Sheet1.Cells(6, 4) = Sheet2.Cells(k, 4)
            Sheet1.Cells(6, 5) = Sheet2.Cells(k, 3)
    End If
    
    If Sheet2.Cells(k, 5) <> "" And Sheet2.Cells(k, 2) = "PARTS" And Sheet2.Cells(k, 4) = "JPY" Then
        Sheet1.Cells(5, 6) = Sheet2.Cells(k, 5)
        Sheet1.Cells(5, 7) = Sheet2.Cells(k, 4)
        Sheet1.Cells(5, 8) = Sheet2.Cells(k, 3)
    End If
    If Sheet2.Cells(k, 5) <> "" And Sheet2.Cells(k, 2) = "PARTS" And Sheet2.Cells(k, 4) = "USD" Then
        Sheet1.Cells(6, 6) = Sheet2.Cells(k, 5)
        Sheet1.Cells(6, 7) = Sheet2.Cells(k, 4)
        Sheet1.Cells(6, 8) = Sheet2.Cells(k, 3)
    End If
    
'1010000001 KKK01
    If Sheet3.Cells(k, 5) <> "" And Sheet3.Cells(k, 2) = "OTHERS" Then
        Sheet1.Cells(7, 12) = Sheet3.Cells(2, 5) + Sheet13.Cells(8, 4)
    End If

'1010000010 KKK10
    If Sheet4.Cells(k, 5) <> "" And Sheet4.Cells(k, 2) = "PARTS" And Sheet4.Cells(k, 4) = "JPY" Then
        Sheet1.Cells(10, 6) = Sheet4.Cells(k, 5)
        Sheet1.Cells(10, 7) = Sheet4.Cells(k, 4)
        Sheet1.Cells(10, 8) = Sheet4.Cells(k, 3)
    End If

'1010000011 KKK11
    If Sheet5.Cells(k, 5) <> "" And Sheet5.Cells(k, 2) = "OTHERS" Then
        Sheet1.Cells(12, 12) = Sheet5.Cells(2, 5) + Sheet13.Cells(16, 4)
    End If


'1010000020 KKK20
    If Sheet6.Cells(k, 5) <> "" And Sheet6.Cells(k, 2) = "GOODS" And Sheet6.Cells(k, 4) = "JPY" Then
            Sheet1.Cells(15, 3) = Sheet6.Cells(k, 5)
            Sheet1.Cells(15, 4) = Sheet6.Cells(k, 4)
            Sheet1.Cells(15, 5) = Sheet6.Cells(k, 3)


'1010000030 KBT
    If Sheet7.Cells(k, 5) <> "" And Sheet7.Cells(k, 2) = "PARTS" And Sheet7.Cells(k, 4) = "USD" Then
        Sheet1.Cells(18, 6) = Sheet7.Cells(k, 5)
        Sheet1.Cells(18, 7) = Sheet7.Cells(k, 4)
        Sheet1.Cells(18, 8) = Sheet7.Cells(k, 3)
    End If
            
 '1010000031 KKK31
    If Sheet8.Cells(k, 5) <> "" And Sheet8.Cells(k, 2) = "OTHERS" Then
        Sheet1.Cells(20, 12) = Sheet8.Cells(2, 5) + Sheet13.Cells(28, 4)
    End If
            
 '1010000051 KFI51
    If Sheet9.Cells(k, 5) <> "" And Sheet9.Cells(k, 2) = "OTHERS" Then
        Sheet1.Cells(23, 12) = Sheet9.Cells(2, 5) + Sheet13.Cells(32, 4)
    End If
            
'1012070000 KMTC00
    If Sheet10.Cells(k, 5) <> "" And Sheet10.Cells(k, 2) = "GOODS" And Sheet10.Cells(k, 4) = "THB" Then
            Sheet1.Cells(26, 3) = Sheet10.Cells(k, 5)
            
    If Sheet10.Cells(k, 5) <> "" And Sheet10.Cells(k, 2) = "PARTS" And Sheet10.Cells(k, 4) = "JPY" Then
        Sheet1.Cells(26, 6) = Sheet10.Cells(k, 5)
        Sheet1.Cells(26, 7) = Sheet10.Cells(k, 4)
        Sheet1.Cells(26, 8) = Sheet10.Cells(k, 3)
    End If
            
 '1012070001 KMTC01
    If Sheet11.Cells(k, 5) <> "" And Sheet11.Cells(k, 2) = "OTHERS" Then
        Sheet1.Cells(28, 12) = Sheet11.Cells(2, 5) + Sheet13.Cells(40, 4)
    End If
            
 '1045010001 KSI01
    If Sheet12.Cells(k, 5) <> "" And Sheet12.Cells(k, 2) = "OTHERS" Then
        Sheet1.Cells(31, 12) = Sheet9.Cells(2, 5) + Sheet13.Cells(44, 4)
    End If
r = r + 1
Next
End Sub

Code: Select all

Public Sub TestTest()
    Dim rCode As Range, rEachComp As Range, r As Range, r1 As Range, _
        dCompCode As Double, sHt As Worksheet, _
        aRR() As Variant, iG%, iP%
    
    Set rCode = ActiveSheet.Range("a:a").SpecialCells(xlCellTypeConstants)
    
    For Each sHt In ThisWorkbook.Sheets
        '~~> ตรวจชื่อชีท สนใจชีทที่ขึ้นต้นด้วย K
        If sHt.Name Like "K*" Then
            ReDim aRR(1 To 2, 1 To 10)
            With sHt
                dCompCode = .Range("a2").Value
                Set rEachComp = .Range("f2:f5")
            End With
            '~~~> สร้าง array
            iG = 1:     iP = 1
            aRR(1, 10) = 0
            For Each r In rEachComp
                If r.Value = "" Then Exit For
                Select Case UCase(r.Offset(, -4).Value)
                    Case Is = "GOODS"
                        aRR(iG, 1) = r.Offset(, -1).Value
                        If r.Value <> r.Offset(, -2).Value Then
                            aRR(iG, 2) = r.Offset(, -2).Value
                            aRR(iG, 3) = r.Offset(, -3).Value
                        End If
                        iG = iG + 1
                    Case Is = "PARTS"
                        aRR(iP, 4) = r.Offset(, -1).Value
                        If r.Value <> r.Offset(, -2).Value Then
                            aRR(iP, 5) = r.Offset(, -2).Value
                            aRR(iP, 6) = r.Offset(, -3).Value
                        End If
                        iP = iP + 1
                    Case Is = "OTHERS"
                        aRR(1, 10) = aRR(1, 10) + r.Offset(, -1).Value
                End Select
                '~~~> ตรวจชีทสุดท้าย ข้อมูลบันทึกไม่ทัน
                With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                    For Each r1 In .Range("a:a").SpecialCells(xlCellTypeConstants)
                        If r1.Value = dCompCode Then
                            aRR(1, 8) = r1.Offset(3, 3).Value
                        End If
                    Next r1
                End With
            Next r
            
            '~~~> ใส่ array ใน Report
            For Each r In rCode
                If r.Value = dCompCode Then
                    With r.Offset(, 2).Resize(2, 10)
                        .ClearContents
                        .Value = aRR
                    End With
                    r.Offset(, 10).Value = r.Offset(, 2).Value + r.Offset(, 5).Value _
                                           + r.Offset(, 9).Value
                    r.Offset(1, 10).Value = r.Offset(1, 2).Value + r.Offset(1, 5).Value _
                                           + r.Offset(1, 9).Value
                    Exit For
                End If
            Next r
        End If
    Next sHt
End Sub

Code: Select all

Worksheets("REPORT").Activate
Set rCode = ActiveSheet.Range("a:a").SpecialCells(xlCellTypeConstants)
For k = 1 To lngLastRow
        If Sheets("Vendor_All").Cells(k, 2) = "*" Then
            ReDim aRR(1 To 2, 1 To 10)
            StrVendorCode = Trim(Sheets("Vendor_All").Cells(k, 13))
            rCurr = Trim(Sheets("Vendor_All").Cells(k, 11))
            rPrd = Trim(Sheets("Vendor_All").Cells(k, 7))
            
            iG = 1:     iP = 1
            aRR(1, 10) = 0
                Select Case rPrd
                    Case Is = "GOODS"
                        aRR(iG, 1) = Trim(Sheets("Vendor_All").Cells(k, 10))
                        If rCurr <> Trim(Sheets("Vendor_All").Cells(k, 9)) Then
                            aRR(iG, 2) = Trim(Sheets("Vendor_All").Cells(k, 9))
                            aRR(iG, 3) = Trim(Sheets("Vendor_All").Cells(k, 8))
                        End If
                       iG = iG + 1
                    Case Is = "PARTS"
                        aRR(iP, 4) = Trim(Sheets("Vendor_All").Cells(k, 10))
                        If rCurr <> Trim(Sheets("Vendor_All").Cells(k, 9)) Then
                            aRR(iP, 5) = Trim(Sheets("Vendor_All").Cells(k, 9))
                            aRR(iP, 6) = Trim(Sheets("Vendor_All").Cells(k, 8))
                        End If
                        iP = iP + 1
                    Case Is = "OTHERS"
                        aRR(1, 10) = Trim(Sheets("Vendor_All").Cells(k, 10))
                End Select
            End If
        Next k
    
        Worksheets("REPORT").Activate
            For r = 1 To 200
                If Sheets("REPORT").Cells(r, 1) = StrVendorCode Then
                    With r.Offset(, 2).Resize(2, 10)
                        .ClearContents
                        .Value = aRR
                    End With
                    r.Offset(, 10).Value = r.Offset(, 2).Value + r.Offset(, 5).Value _
                                           + r.Offset(, 9).Value
                    r.Offset(1, 10).Value = r.Offset(1, 2).Value + r.Offset(1, 5).Value _
                                           + r.Offset(1, 9).Value
                    Exit For
                End If
            Next r
End Sub

Code: Select all

Private Sub CmdVendorcopy_Click()
    Dim r As Range, r2 As Range, rCode As Range, rVendor As Range
    Dim StrVendorCode As Double
    Dim aRR() As Variant, iG%, iP%
    Dim k As Long, lngLastRow As Long
    
    lngLastRow = Worksheets("Vendor_All").Cells(Cells.Rows.Count, 2).End(xlUp).Row
    
    With Sheets("report")
        .Activate
        Set rCode = .Range("a:a").SpecialCells(xlCellTypeConstants, 1)
    End With
    For Each r In rCode
        r.Offset(, 2).Resize(2, 10).ClearContents
    Next r
    
    With Sheets("vendor_all")
        Set rVendor = .Range("a:a").SpecialCells(xlCellTypeConstants)
        '~~> ลูปแรก คอลัมน์ A หาคำว่า vendor
        For Each r In rVendor
            If InStr(r.Value, "Vendor") > 0 Then
                StrVendorCode = r.Offset(, 5).Value
                ReDim aRR(1 To 2, 1 To 10)
                iG = 1:     iP = 1
                
                '~~> ลูปสอง คอลัมน์ B หา '*'
                For k = r.Row To lngLastRow
                    If .Cells(k, "b").Value = "**" Then Exit For
                    If .Cells(k, "b").Value = "*" Then
                        Select Case UCase(Trim(.Cells(k, "g").Value))
                            Case Is = "GOODS"
                                aRR(iG, 1) = .Cells(k, "j").Value
                                If .Cells(k, "k") <> .Cells(k, "i") Then
                                    aRR(iG, 2) = .Cells(k, "i").Value
                                    aRR(iG, 3) = .Cells(k, "h").Value
                                End If
                                iG = iG + 1
                            Case Is = "PARTS"
                                aRR(iP, 4) = .Cells(k, "j").Value
                                If .Cells(k, "k") <> .Cells(k, "i") Then
                                    aRR(iP, 5) = .Cells(k, "i").Value
                                    aRR(iP, 6) = .Cells(k, "h").Value
                                End If
                                iP = iP + 1
                            Case Is = "OTHERS"
                                aRR(1, 10) = aRR(1, 10) + .Cells(k, "j").Value
                        End Select
                    End If
                Next k
                
                aRR(1, 9) = aRR(1, 1) + aRR(1, 4) + aRR(1, 8)
                aRR(2, 9) = aRR(2, 1) + aRR(2, 4) + aRR(2, 8)
                
                '~~> ลูปสาม หารหัสเดียวกันในชีท report
                For Each r2 In rCode
                    If r2.Value = StrVendorCode Then
                        r2.Offset(, 2).Resize(2, 10).Value = aRR
                    End If
                Next r2
            End If
        Next r
    End With
End Sub

Code: Select all

Private Sub CmdVendorcopy_Click()
    Dim r As Range, r1 As Range, r2 As Range, r3 As Range, rCode As Range, rVendor As Range
    Dim StrVendorCode As Double
    Dim aRR() As Variant, iG%, iP%
    Dim k, k1 As Long, lngLastRow As Long
       
    lngLastRow = Worksheets("Vendor_All").Cells(Cells.Rows.Count, 2).End(xlUp).Row
    
    With Sheets("report")
        .Activate
        Set rCode = .Range("a:a").SpecialCells(xlCellTypeConstants, 1)
    End With
    For Each r In rCode
    
        r.Offset(, 2).Resize(2, 10).ClearContents
    Next r
    
    With Sheets("vendor_all")
        Set rVendor = .Range("a:a").SpecialCells(xlCellTypeConstants)
        '~~> Loop 1 คอลัมน์ A หาคำว่า vendor
        For Each r In rVendor
            If InStr(r.Value, "Vendor") > 0 Then
                StrVendorCode = r.Offset(, 5).Value
                ReDim aRR(1 To 2, 1 To 10)
                iG = 1:     iP = 1
                
                '~~> Loop 2 คอลัมน์ B หา '*'
                For k = r.Row To lngLastRow
                    If .Cells(k, "b").Value = "**" Then Exit For
                    If .Cells(k, "b").Value = "*" Then
                        Select Case UCase(Trim(.Cells(k, "g").Value))
                            Case Is = "GOODS"
                                aRR(iG, 1) = .Cells(k, "j").Value
                                If .Cells(k, "k") <> .Cells(k, "i") Then
                                    aRR(iG, 2) = .Cells(k, "i").Value
                                    aRR(iG, 3) = .Cells(k, "h").Value
                                End If
                                iG = iG + 1
                            Case Is = "PARTS"
                                aRR(iP, 4) = .Cells(k, "j").Value
                                If .Cells(k, "k") <> .Cells(k, "i") Then
                                    aRR(iP, 5) = .Cells(k, "i").Value
                                    aRR(iP, 6) = .Cells(k, "h").Value
                                End If
                                iP = iP + 1
                            Case Is = "OTHERS"
                                aRR(1, 10) = aRR(1, 10) + .Cells(k, "j").Value
                        End Select
                        
                '--> Loop 3 ตรวจข้อมูล Sheet รายการบันทึกไม่ทัน
                    With Sheets("ข้อมูลบันทึกไม่ทัน")
                        For Each r1 In .Range("a:a").SpecialCells(xlCellTypeConstants)
                            If r1.Value = StrVendorCode Then
                                aRR(1, 8) = r1.Offset(3, 3).Value
                            End If
                        Next r1
                    End With
                End If
            Next k
             
            '--> Loop 4 ตรวจข้อมูล Sheet Accrued
                    With Sheets("Accrued 240399005")
                        For Each r3 In .Range("s:s").SpecialCells(xlCellTypeConstants)
                            If r3.Value = StrVendorCode Then
                                 aRR(1, 10) = aRR(1, 10) + r3.Offset(0, 4).Value
                            End If
                        Next r3
                    End With
                    
            '--> Loop 5 ข้อมูล Sheet GR-IR 211101000
                    With Sheets("GR-IR 211101000")
                        For k1 = 9 To 28
                            If .Cells(k1, "ar").Value = "" Then Exit For
                            If .Cells(k1, "ar").Value = StrVendorCode Then
                            iG = 1:     iP = 1

                                Select Case UCase(Trim(.Cells(k1, "as").Value))
                                    Case Is = "FG"
                                        aRR(iG, 1) = aRR(iG, 1) + .Cells(k1, "av").Value
                                            If .Cells(k1, "au") <> .Cells(k1, "av") Then
                                                aRR(iG, 2) = .Cells(k1, "at").Value
                                                aRR(iG, 3) = aRR(iG, 3) + .Cells(k1, "au").Value
                                            End If
                                        iG = iG + 1
                                    Case Is = "SP"
                                        aRR(iP, 4) = aRR(iP, 4) + .Cells(k1, "av").Value
                                            If .Cells(k1, "au") <> .Cells(k1, "av") Then
                                                aRR(iP, 5) = .Cells(k1, "at").Value
                                                aRR(iP, 6) = aRR(iP, 6) + .Cells(k1, "au").Value
                                            End If
                                        iP = iP + 1
                                End Select
                            End If
                        Next k1
                    End With
                        
                
                aRR(1, 9) = aRR(1, 1) + aRR(1, 4) + aRR(1, 8)
                aRR(2, 9) = aRR(2, 1) + aRR(2, 4) + aRR(2, 8)
                
                '~~> Loop 6 หารหัสเดียวกันใน Sheet report
                For Each r2 In rCode
                    If r2.Value = StrVendorCode Then
                        r2.Offset(, 2).Resize(2, 10).Value = aRR
                    End If
                Next r2
            End If
        Next r
    End With
End Sub

Code: Select all

Private Sub CmdVendorcopy_Click()
    Dim r As Range, r1 As Range, r2 As Range, rTemp As Range, _
        rCode As Range, rVendor As Range
    Dim dVendorCode As Double
    Dim aRR() As Variant, iG%, iP%, k%
    
    With Sheets("report")
        .Activate
        Set rCode = .Range("a:a").SpecialCells(xlCellTypeConstants, 1)
    End With
    
    '~~> 1st Loop for each vendor code in REPORT
    For Each r In rCode
        dVendorCode = r.Value
        With Sheets("vendor_all")
            Set rVendor = .Range("a:a").SpecialCells(xlCellTypeConstants)
            
            '~~> 2nd Loop for finding the row this vendor is
            For Each r1 In rVendor
                If InStr(r1.Value, "Vendor") > 0 Then
                    ReDim aRR(1 To 2, 1 To 10)
                    iG = 1:         iP = 1
                    If r1.Offset(, 5).Value = dVendorCode Then
                        Set rTemp = .Range("b" & r1.Row).Resize(200, 1).SpecialCells(xlCellTypeConstants)
                        
                        '~~> 3rd Loop for collecting this vendor's data
                        For Each r2 In rTemp
                            If r2.Value = "**" Then Exit For
                            If r2.Value = "*" Then
                                Select Case Trim(r2.Offset(, 5).Value)
                                    Case Is = "GOODS"
                                        aRR(iG, 1) = r2.Offset(, 8).Value
                                        If r2.Offset(, 7) <> r2.Offset(, 9) Then
                                            aRR(iG, 2) = r2.Offset(, 7).Value
                                            aRR(iG, 3) = r2.Offset(, 6).Value
                                        End If
                                        iG = iG + 1
                                    Case Is = "PARTS"
                                        aRR(iP, 4) = r2.Offset(, 8).Value
                                        If r2.Offset(, 7) <> r2.Offset(, 9) Then
                                            aRR(iP, 5) = r2.Offset(, 7).Value
                                            aRR(iP, 6) = r2.Offset(, 6).Value
                                        End If
                                        iP = iP + 1
                                    Case Is = "OTHERS"
                                        aRR(1, 10) = aRR(1, 10) + r2.Offset(, 8).Value
                                End Select
                            End If
                        Next r2
                        Exit For
                    End If
                End If
            Next r1
        End With
        
        '~~> 4th
        With Sheets("ข้อมูลบันทึกไม่ทัน")
            For Each r1 In .Range("a:a").SpecialCells(xlCellTypeConstants)
                If r1.Value = dVendorCode Then
                    aRR(1, 8) = r1.Offset(3, 3).Value
                    Exit For
                End If
            Next r1
        End With
        
        '~~> 5th
        With Sheets("GR-IR 211101000")
            For Each r1 In .Range("ar:ar").SpecialCells(xlCellTypeConstants)
                If r1.Value = dVendorCode Then
                    For k = 1 To 2
                        Select Case r1.Offset(, 1).Value
                            Case Is = "FG"
                                If aRR(k, 2) = r1.Offset(, 2).Value Or _
                                    (IsEmpty(aRR(k, 2)) And r1.Offset(, 2).Value = "THB") Then
                                    aRR(k, 1) = aRR(k, 1) + r1.Offset(, 4).Value
                                    If r1.Offset(, 4) <> r1.Offset(, 3) Then _
                                        aRR(k, 3) = aRR(k, 3) + r1.Offset(, 3).Value
                                    Exit For
                                End If
                            Case Is = "SP"
                                If aRR(k, 2) = r1.Offset(, 2).Value Or _
                                    (IsEmpty(aRR(k, 2)) And r1.Offset(, 2).Value = "THB") Then
                                    aRR(k, 4) = aRR(k, 4) + r1.Offset(, 4).Value
                                    If r1.Offset(, 4) <> r1.Offset(, 3) Then _
                                        aRR(k, 6) = aRR(k, 6) + r1.Offset(, 3).Value
                                    Exit For
                                End If
                        End Select
                    Next k
                End If
            Next r1
        End With
        
        '~~> 6th
        With Sheets("Accrued 240399005")
            For Each r1 In .Range("s:s").SpecialCells(xlCellTypeConstants)
                If r1.Value = dVendorCode Then
                    aRR(1, 10) = aRR(1, 10) + r1.Offset(, 4).Value
                End If
            Next r1
        End With
        
        r.Offset(, 2).Resize(2, 10).ClearContents
        r.Offset(, 2).Resize(2, 10).Value = aRR
    Next r
End Sub