Excel Forum

Code: Select all

Sub CopyRowsBasedOnCondition()
    Dim ws As Worksheet
    Dim wsCP As Worksheet
    Dim wsPaidNo As Worksheet
    Dim wsNonCP As Worksheet
    Dim lastRowCP As Long
    Dim lastRowNonCP As Long
    Dim lastRowPaidNo As Long
    Dim i As Long, j As Long
    Dim foundMatch As Boolean

    ' กำหนดชีทที่ต้องการ
    Set wsPaidNo = ThisWorkbook.Sheets("Paid_No")
    lastRowPaidNo = wsPaidNo.Cells(wsPaidNo.Rows.Count, "B").End(xlUp).Row
    
    ' ลูปผ่านชีทที่มีคำว่า "CP" ในชื่อ
    For Each wsCP In ThisWorkbook.Sheets
        If InStr(1, wsCP.Name, "CP") > 0 Then
            lastRowCP = wsCP.Cells(wsCP.Rows.Count, "C").End(xlUp).Row

            ' ลูปผ่านชีทที่ไม่มีคำว่า "CP" ในชื่อ และไม่ใช่ชีท "Paid_Yes", "Paid_No", "Main"
            For Each ws In ThisWorkbook.Sheets
                If Not InStr(1, ws.Name, "CP") > 0 And ws.Name <> "Paid_Yes" And ws.Name <> "Paid_No" And ws.Name <> "Main" Then
                    lastRowNonCP = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

                    ' ลูปผ่านข้อมูลในคอลัมน์ C ของชีท CP
                    For i = 10 To lastRowCP
                        foundMatch = False
                        
                        ' ลูปผ่านข้อมูลในคอลัมน์ C ของชีท Non-CP
                        For j = 9 To lastRowNonCP
                            If wsCP.Cells(i, "C").Value = ws.Cells(j, "C").Value Then
                                foundMatch = True
                                Exit For
                            End If
                        Next j
                        
                        ' ถ้าไม่พบข้อมูลที่ตรงกัน ให้คัดลอกแถวนั้นไปวางในชีท Paid_No
                        If Not foundMatch Then
                            wsCP.Range(wsCP.Cells(i, "A"), wsCP.Cells(i, "AQ")).Copy
                            wsPaidNo.Cells(lastRowPaidNo + 1, "B").PasteSpecial Paste:=xlPasteValues
                            lastRowPaidNo = lastRowPaidNo + 1
                        End If
                    Next i
                End If
            Next ws
        End If
    Next wsCP
    
    Application.CutCopyMode = False
End Sub

Code: Select all

Sub Paid_N()

    Dim wsCP As Worksheet
    Dim ws As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRowCP As Long, lastRow As Long
    Dim i As Long, j As Long
    Dim found As Boolean

    ' Set the target sheet
    Set wsTarget = ThisWorkbook.Sheets("Paid_NO")
    
    ' Clear existing data in Paid_NO from B6 downwards
    wsTarget.Range("B6:B" & wsTarget.Cells(wsTarget.Rows.Count, "B").End(xlUp).Row).ClearContents

    ' Loop through each sheet in the workbook
    For Each wsCP In ThisWorkbook.Sheets
        ' Check if the sheet name contains "CP"
        If InStr(1, wsCP.Name, "CP", vbTextCompare) > 0 Then
            lastRowCP = wsCP.Cells(wsCP.Rows.Count, "C").End(xlUp).Row
            
            ' Loop through each row starting from row 10
            For i = 10 To lastRowCP
                found = False
                
                ' Check other sheets
                For Each ws In ThisWorkbook.Sheets
                    If ws.Name <> wsCP.Name And ws.Name <> "Paid_Yes" And ws.Name <> "Paid_No" And ws.Name <> "Main" Then
                        lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
                        
                        ' Compare with rows in other sheets from row 9 downwards
                        For j = 9 To lastRow
                            If wsCP.Cells(i, "C").Value = ws.Cells(j, "C").Value Then
                                found = True
                                Exit For
                            End If
                        Next j
                        
                        If found Then Exit For
                    End If
                Next ws
                
                ' If not found in any other sheet, copy the row to Paid_NO
                If Not found Then
                    wsCP.Range("A" & i & ":AQ" & i).Copy
                    wsTarget.Range("B" & wsTarget.Cells(wsTarget.Rows.Count, "B").End(xlUp).Row + 1).PasteSpecial xlPasteValues
                End If
            Next i
        End If
    Next wsCP
    
    ' Clear the clipboard
    Application.CutCopyMode = False

    MsgBox "Data copy process is complete!"

End Sub

End Sub

Code: Select all

'Other code            ' ลูปผ่านชีทที่ไม่มีคำว่า "CP" ในชื่อ และไม่ใช่ชีท "Paid_Yes", "Paid_No", "Main"
            For Each ws In ThisWorkbook.Sheets
                If Not InStr(1, ws.Name, "CP") > 0 And ws.Name <> "Paid_Yes" And ws.Name <> "Paid_No" And ws.Name <> "Main" Then
                    lastRowNonCP = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

                    ' ลูปผ่านข้อมูลในคอลัมน์ C ของชีท CP
                    For i = 10 To lastRowCP
                        If Not IsEmpty(wsCP.Cells(i, "A")) And IsNumeric(wsCP.Cells(i, "A")) Then
                            foundMatch = False
                            
                            ' ลูปผ่านข้อมูลในคอลัมน์ C ของชีท Non-CP
                            For j = 9 To lastRowNonCP
                                If wsCP.Cells(i, "C").Value = ws.Cells(j, "C").Value Then
                                    foundMatch = True
                                    Exit For
                                End If
                            Next j
                            
                            ' ถ้าไม่พบข้อมูลที่ตรงกัน ให้คัดลอกแถวนั้นไปวางในชีท Paid_No
                            If Not foundMatch Then
                                wsCP.Range(wsCP.Cells(i, "A"), wsCP.Cells(i, "AQ")).Copy
                                wsPaidNo.Cells(lastRowPaidNo + 1, "B").PasteSpecial Paste:=xlPasteValues
                                lastRowPaidNo = lastRowPaidNo + 1
                            End If
                        End If
                    Next i
                End If
            Next ws
'Other code

Code: Select all

Sub CopyRowsBasedOnCondition_()
     Dim dCp As Object, strCp As String, rngCPs As Range, rngCp As Range
     Dim dnCp As Object, strNcp As String, rngNCps As Range, rngNcp As Range
     Dim sh As Worksheet, itm As Variant, i As Integer, strShN As String, rw As Integer
     
     Set dCp = CreateObject("Scripting.Dictionary")
     Set dnCp = CreateObject("Scripting.Dictionary")
     For Each sh In Worksheets
        If InStr(sh.Name, "CP") Then
            Set rngCPs = sh.Range("c10", sh.Range("c" & sh.Rows.Count).End(xlUp))
            For Each rngCp In rngCPs
                strCp = CStr(rngCp.Value)
                If IsNumeric(strCp) And Not dCp.Exists(strCp) Then
                    dCp.Add Key:=strCp, Item:=sh.Name & "|" & rngCp.Row
                End If
            Next rngCp
        ElseIf InStr("Main|Paid_No|Paid_Yes|CP", sh.Name) = 0 Then
            Set rngNCps = sh.Range("c9", sh.Range("c" & sh.Rows.Count).End(xlUp))
            For Each rngNcp In rngNCps
                strNcp = CStr(rngNcp.Value)
                If IsNumeric(strNcp) And Not dnCp.Exists(strNcp) Then
                    dnCp.Add Key:=strNcp, Item:=sh.Name & "|" & rngNcp.Row
                End If
            Next rngNcp
        End If
     Next sh
     For Each itm In dCp.keys
        If Not dnCp.Exists(itm) Then
            strShN = VBA.Split(dCp.Item(itm), "|")(0)
            rw = VBA.Split(dCp.Item(itm), "|")(1)
            With Worksheets("Paid_No")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(, 177).Value = _
                    Worksheets(strShN).Cells(rw, "a").Resize(, 177).Value
            End With
        End If
     Next itm
End Sub

Code: Select all

'Other code
            With Worksheets("Paid_No")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(, 177).Value = _
                    Worksheets(strShN).Cells(rw, "a").Resize(, 177).Value
            End With
'Other code