Search code examples
excelms-accessvbaexcel-2007

Finding status of data and copying across sheets

I am very new to VBA. Hope someone can help me out. Thanks a lot.

Sheet 1 (Data to be copied to Sheet 4)

     A       B        C           D
 1  ID    Header 2  Header 3    Orders
 2 5000                      455,476,497
 3 5012                          500
 4 5015                        502,503

Sheet 2 (Data)

     A         B         C         D ........ Q
1  Orders ID         Header 2   Status   Header 4
2   455                         Closed
3   456                          Open
4   476                         Closed
5   497                         Closed

Sheet 3

   A    B    C    D
1 455  476  497
2 500
3 502  503

Sheet 4 (Output Sheet)

     A       B        C           D
 1  ID    Header 2  Header 3    Orders
 2 5000                      455,476,497
 3

Task: I need to check the status of the following ids 455, 476 and 497 in sheet 3. If the status of all IDs in a row is closed then copy the whole row from sheet 1 to sheet 4, if not move on to the next line.

For a = 1 To Range("A1").End(xlDown).Row

    For b = 1 To Range("A1").End(xlToRight).Column
        Cells(1, b).Select

        Selection.Copy
        Sheets("Orders").Select            

       (Unsure what to put here)

    Next b
Next a

I need more reputation to post images here. So, posting the links (only 2 allowed )

https://i.sstatic.net/sVXfS.jpg, https://i.sstatic.net/sUhFo.jpg, U0Z7mfm, qWOJ3VM

Solution

  • Please try the below code

    Sub FindStausAndCopy()

Dim sheet1Range As Range
Dim sheet2Range As Range
Dim sheet3Range As Range

Dim sheet1RowCount As Integer
Dim sheet1ColCount As Integer

Dim sheet2RowCount As Integer
Dim sheet2ColCount As Integer

Dim sheet3RowCount As Integer
Dim sheet3ColCount As Integer

Dim shtRowNum As Integer
Dim totalCellsinRow  As Integer
Dim statusCount As Integer
Dim orders As String

Dim range1Row As Variant
Dim range2Row As Variant
Dim range3Row As Variant
Dim cellVal As Variant



sheet1RowCount = Worksheets("Sheet1").UsedRange.Rows.Count
sheet1ColCount = Worksheets("Sheet1").UsedRange.Columns.Count

sheet2RowCount = Worksheets("Sheet2").UsedRange.Rows.Count
sheet2ColCount = Worksheets("Sheet2").UsedRange.Columns.Count

sheet3RowCount = Worksheets("Sheet3").UsedRange.Rows.Count
sheet3ColCount = Worksheets("Sheet3").UsedRange.Columns.Count

Worksheets("sheet1").Activate
Set sheet1Range = Worksheets("Sheet1").Range(Cells(1, 1), Cells(sheet1RowCount, sheet1ColCount))
Worksheets("sheet2").Activate
Set sheet2Range = Worksheets("Sheet2").Range(Cells(1, 1), Cells(sheet2RowCount, sheet2ColCount))
Worksheets("sheet3").Activate
Set sheet3Range = Worksheets("Sheet3").Range(Cells(1, 1), Cells(sheet3RowCount, sheet3ColCount))

shtRowNum = 1 'This is for incrementing the Row in Sheet4
'Iterating through Each row in Sheet3 and then through
'each cell in a particular row
'Loop1
For Each range3Row In sheet3Range.Rows
totalCellsinRow = 0  ' to count no of order numbers in sheet3 rows
statusCount = 0      ' to count the status of orders 
orders = ""          ' to store all order numbers with coma seperated

    'Iterating throgh each Order in a row and identifing the status
    'Loop2
    For Each cellVal In range3Row.Cells
    If (cellVal <> "") Then
     totalCellsinRow = totalCellsinRow + 1 'Increments for every order
     'Iterating through each row in sheet2 to check the status and
     ' Increment status count
     'Loop3
         For Each range2Row In sheet2Range.Rows
            If (range2Row.Cells(1) = cellVal And range2Row.Cells(4) = "Closed") Then
            statusCount = statusCount + 1 'Increments only when order is closed
            orders = orders & ", " & cellVal
            End If
        Next range2Row
        'By the time Loop3 is completed we get the status of one order
        End If
    Next cellVal
    'By the time Loop2 is completed, we get the overall status of all orders
    ' in a row of sheet3
    ' If statusCount = totalCellsinRow which implies every order
    ' present in a row is closed
    If (totalCellsinRow = statusCount) Then
        'Lopp4: Iterating throgh each row of sheet1 to find Matching ID
        'The reason for iterating through rows,even if the order of the ID
        ' changes, code should be in a position to identify the right row
        ' to copy
        For Each range1Row In sheet1Range.Rows
            If (range1Row.Cells(4) = Trim(Right(orders, Len(orders) - 1))) Then
              If (shtRowNum = 1) Then
              'Copying the Header row to sheet4 only once.
              sheet1Range.Rows(1).Copy Destination:=Worksheets("sheet4").Cells(1, 1) 
              shtRowNum = shtRowNum + 1
            End If
            'Copying the row from sheet1 to sheet4
            range1Row.Copy Destination:=Worksheets("Sheet4").Cells(shtRowNum, 1)
            shtRowNum = shtRowNum + 1
          End If
        Next range1Row
        'By the time Loop4 is completed a ID row for the closed Orders will 
        ' be copied to Sheet4
    End If
Next range3Row
'By the time Loop1 is completed all the orders status will be read
' Corresponding Id rows will be copied to sheet4 with Header row

End Sub

    Below are the results enter image description here