Excel VBA Course

(35% Sale Ends Jan. 26)

Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course (35% Discount)

Looping through worksheets (see Body)

0

Hi Don, Do you have a ready made macro / VBA to do the following please?

I have a very basic VBA experience of VBA ( I'm looking forward to your course on 11th Jan)

 I would like to loop through several worksheets in the same workbook

Look at a cell in each row, column P

If the cell is blank, go onto next row / next worksheet and so on until the end of worksheets

If the cell in column P has a number in it, I would like to copy the whole row(s) to a new blank worksheet called "Current Stock" or something similar.

(I don't want to include the "Current Stock" work sheet in the list of worksheets to look at, if you know what I mean )

Many thanks in advance and Very Kind regards, Paul

Answer
Discuss

Discussion

Paul

I know Don owns the Forum but he's a busy man so it's better not to address your queries to him (or any individual on the Forum). I've given you one answer anyway.
John_Ru (rep: 2857) Jan 3, '22 at 10:38 am
Thank you so much John, it works perfectly.
This was my first ever question, I note your comments above
Very kind regards, Paul
MonBarks (rep: 2) Jan 3, '22 at 11:46 am
Great, thanks for selecting my Answer, Paul.

Suggest you check out the Rules of the Forum (and Etiquette) so you're ready for your next question. 
John_Ru (rep: 2857) Jan 3, '22 at 12:00 pm
Add to Discussion

Answers

0
Selected Answer

Paul

The attached file contains the specially-written code below which can be run by clicking the button marked "Collect rows with numbers in column P" on the sheet called Current Stock. It should do what you request:

Sub CheckColP()

Dim Report As Worksheet
Dim ws As Worksheet, n As Long
Dim LstRwRpt As Long
Dim LstRwP As Long, Cl As Range

Set Report = ThisWorkbook.Worksheets("Current Stock")
Report.UsedRange.Offset(1, 0).ClearContents
LstRwRpt = 1

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> Report.Name Then

        LstRwP = ws.Range("P" & Rows.Count).End(xlUp).Row
        For n = 1 To LstRwP
            Set Cl = ws.Cells(n, "P")
            If Not IsEmpty(Cl) And IsNumeric(Cl) Then
                Report.Rows(LstRwRpt + 1).Value = Cl.EntireRow.Value
                LstRwRpt = LstRwRpt + 1
            End If
        Next n
    End If
Next ws

End Sub
You'll need to manually clear the Current Stock sheet to prove it is being populated (though that is done in the macro) and may want to format columns to match your actual data sheets (e.g. for dates).

In the version of the code below, I've added comments (which will appear in red) to explain what the code is doing:

Sub CheckColP()
' Name/ declare the variables/types we'll use (not essential)
Dim Report As Worksheet
Dim ws As Worksheet, n As Long
Dim LstRwRpt As Long
Dim LstRwP As Long, Cl As Range

'set the Report sheet
Set Report = ThisWorkbook.Worksheets("Current Stock")
'clear anything not in row 1
Report.UsedRange.Offset(1, 0).ClearContents
'record the last row used in column P (which will be the first)
LstRwRpt = 1

' loop through all sheets in this file
For Each ws In ThisWorkbook.Worksheets
    'Skip the sheet used for Report
    If ws.Name <> Report.Name Then
        'detemine the last filled cell in column P of that sheet
        LstRwP = ws.Range("P" & Rows.Count).End(xlUp).Row
        'Loop up to that row
        For n = 1 To LstRwP
            'identify the cell in column P or 16
            Set Cl = ws.Cells(n, "P")
            'check it's not empty and contains something like a number
            If Not IsEmpty(Cl) And IsNumeric(Cl) Then
                'If it's a number, copy values from that row to the next empty one in Report
                Report.Rows(LstRwRpt + 1).Value = Cl.EntireRow.Value
                'Increment the Report row counter
                LstRwRpt = LstRwRpt + 1
            End If
        'loop to new row
        Next n
    End If
'loop to next sheet
Next ws

End Sub
Hope this helps and good luck with the VBA course (I haven't seen it but guess Don will have done a good job as usual when creating it).
Discuss


Answer the Question

You must create an account to use the forum. Create an Account or Login