Run Through Cell value and pull data to Another workbook

[Haree]

Hello

Source Workbook : "Daily Sheet"
Source Location : Desktop

Destination Workbook : Return Items
Destination Location : D Drive

I have 12 sheets in the source workbook, one for each month
In each worksheet i have the following data
Column H: Date
Column I : Category
Column J : Party Name
Column K : Particulars
Column L: Bill Value
Column M: Quantity
Column N : Return Qty

If Column I : Category is "Returned Items" (I have a data validation) , i want that particular rows items from column H to Column N copied to the new workbook
I want this for all the worksheets in the source sheet
All the data can be together in the destination workbook

 

[ask2tsp]

Try this sub. It assumes that the Source workbook is in the same path as this workbook.

Sub collectReturnedItems()
'Purpose: Read all sheets in Source and copy the category "Returned Items" rows

    Dim ws      As Worksheet
    Dim rs      As Worksheet
    Dim source  As Workbook
    Dim nm          As String
    Dim sourceRow   As Long
    Dim returnRow   As Long
    Dim column      As Long
    Dim category    As String
    
    nm = ThisWorkbook.Path & "\Source.xlsx"
    Set source = Workbooks.Open(nm)
    
    returnRow = 2
    Set rs = ThisWorkbook.Worksheets(1)
    
    For Each ws In source.Worksheets
        sourceRow = 2
        category = ws.Cells(sourceRow, "I")
        While category > ""
            Debug.Assert sourceRow < 100000
            If category = "Returned Items" Then
                For column = 8 To 14
                    rs.Cells(returnRow, column).Value = _
                    ws.Cells(sourceRow, column).Value
                Next column
                returnRow = returnRow + 1
            End If
            sourceRow = sourceRow + 1
            category = ws.Cells(sourceRow, "I")
        Wend
    Next ws
End Sub

 

[Haree]

Hey !
Thank you so much for your time, The VBA runs but it doesn't return any value my destination worksheet is just blank

 

[ask2tsp]

Could you please try the following:

1. Open the Visual Basic Editor
2. Place the cursor on the line "returnRow = 2"
3. Press Ctrl+F8 (Run to cursor)
4. Go to the immediate Window (Ctrl+G)
5. Type "?source.Worksheets.Count" and press Return
   Below it should display "12" (the number of sheets in the Source workbook

If that is not the case
stop the execution of the sub and check the contents of Source.xlsm located in the same folder as this workbook.
else

1. Set the cursor on the line 'While category > ""'
2. Press F9 (Toggle Breakpoint at this line)
3. Show local variables pane
4. Run macro

Now every iteration of the White loop it stops and you can see the value of the category variable. Is it what you expect?
If not check the sheets of the Source workbook. Is this Category in Column I?
etc.

 

[Haree]

Sub collectReturnedItems()
'Purpose: Read all sheets in Source and copy the category "Returned Items" rows

Dim ws As Worksheet
Dim rs As Worksheet
Dim source As Workbook
Dim nm As String
Dim sourceRow As Long
Dim returnRow As Long
Dim column As Long
Dim category As String

nm = "G:\trial runs\Source.xlsm"
Set source = Workbooks.Open(nm)

returnRow = 2
Set rs = ThisWorkbook.Worksheets(1)

For Each ws In source.Worksheets
sourceRow = 2
category = ws.Cells(sourceRow, "I")
While category > ""
Debug.Assert sourceRow < 100000
If category = "Returned Items" Then
For column = 8 To 14
rs.Cells(returnRow, column).Value = _
ws.Cells(sourceRow, column).Value
Next column
returnRow = returnRow + 1
End If
sourceRow = sourceRow + 1
category = ws.Cells(sourceRow, "I")
Wend
Next ws
End Sub



When i ran the immediate window my response was 5 as i have only 5 sheets as of now, every month a sheet would be added. I am sorry i didnt know how to go to the show variables pane.

I have highlighted in yellow, The code worked perfectly till that part, after that the entire while part got skipped and went to Next Ws ( I found this out using F8)

I want to add a line after
For Each ws In source.Worksheets
as

For Each ws In source.Worksheets
If ws.Name <> "Debtors" And ws.Name <> "Total" Then

i tried this and used end if , but it showed compile error , The reason i am omitting these both sheets is they both wont have the column called category thats why.
Sorry for the trouble and thanks in advance

 

[ask2tsp]

Maybe you put the End If in the wrong place. Anyway this works fine for me

Sub collectReturnedItems()
    'Purpose: Read all sheets in Source and copy the category "Returned Items" rows

    Dim ws      As Worksheet
    Dim rs      As Worksheet
    Dim source  As Workbook
    Dim nm          As String
    Dim sourceRow   As Long
    Dim returnRow   As Long
    Dim column      As Long
    Dim category    As String
    
    nm = ThisWorkbook.Path & "\Source.xlsx"
    Set source = Workbooks.Open(nm)
    
    returnRow = 2
    Set rs = ThisWorkbook.Worksheets(1)
    
    For Each ws In source.Worksheets
        If ws.Name <> "Debtors" And ws.Name <> "Total" Then
            sourceRow = 2
            category = ws.Cells(sourceRow, "I")
            While category > ""
                Debug.Assert sourceRow < 100000
                If category = "Returned Items" Then
                    For column = 8 To 14
                        rs.Cells(returnRow, column).Value = _
                            ws.Cells(sourceRow, column).Value
                    Next column
                    returnRow = returnRow + 1
                End If
                sourceRow = sourceRow + 1
                category = ws.Cells(sourceRow, "I")
            Wend
        End If
    Next ws
End Sub

btw Notice the indentation. It makes the code easier to read.

 

[Haree]

Hello Sorry to trouble you again, the code is running properly, its opening the source sheet but doesnt copy values from the source sheet to the Destination sheet, and i have checked the category column in I

 

[ask2tsp]

Please run this version and look at the immediate window after running it.

Sub collectReturnedItems_traced()
    'Purpose: Read all sheets in Source and copy the category "Returned Items" rows

    Dim ws      As Worksheet
    Dim rs      As Worksheet
    Dim source  As Workbook
    Dim nm          As String
    Dim sourceRow   As Long
    Dim returnRow   As Long
    Dim column      As Long
    Dim category    As String
    Dim nbrCopied   As Long
    
    nm = ThisWorkbook.Path & "\Source.xlsx"
    Set source = Workbooks.Open(nm)
    Debug.Print source.FullName, source.Worksheets.Count; " Sheets"
    
    returnRow = 2
    Set rs = ThisWorkbook.Worksheets(1)
    
    For Each ws In source.Worksheets
        Debug.Print ws.Name, ws.Range("I1").CurrentRegion.Address(0, 0)
        
        If ws.Name <> "Debtors" And ws.Name <> "Total" Then
            sourceRow = 2
            category = ws.Cells(sourceRow, "I")
            nbrCopied = 0
            
            While category > ""
                Debug.Assert sourceRow < 100000
                If category = "Returned Items" Then
                    nbrCopied = nbrCopied + 1
                    For column = 8 To 14
                        rs.Cells(returnRow, column).Value = _
                            ws.Cells(sourceRow, column).Value
                    Next column
                    returnRow = returnRow + 1
                End If
                sourceRow = sourceRow + 1
                category = ws.Cells(sourceRow, "I")
            Wend
            Debug.Print , sourceRow - 2; " rows read, "; _
                        nbrCopied; " rows copied."
        End If
    Next ws
End Sub

 

[Haree]

Hi, I ran this and i am pasting the results

G:\trial runs\Source.xlsm 5 Sheets
Total A1:N8
April 2020 A1:N24
0 rows read, 0 rows copied.
May 2020 A1:N294
0 rows read, 0 rows copied.
June 2020 A1:N209
0 rows read, 0 rows copied.
Debtors A1:I24

 

[ask2tsp]

'0 rows read' occurs when cel I2 is empty. Can you check that for me please? Or publish the first 5 rows of one of the month sheets.