I have trouble running this script to obtain Summary information for a specific month. I am explaining below the details of my workbook.

Tab 1 called "Schedule"

Tab 2 called "Results"

Tab 3 called "Sheet3"

I would like to obtain info from column C (Summary) in tab1 for the month of July. I am entering the month in tab2 and would like to run the macro and obtain all the results pertaining to the month of July.

Sub schedule()
    Dim sch As Workbook
    Dim schTot As Worksheet
    Dim schRes As Worksheet
    Dim i As Long
    Dim j As Long
    Let sch = Thisworkbook
    Let schRes = sch.Worksheets("Results")
    Let schTot = sch.Worksheets("Schedule")
    For i = 1 To schTot.Range("A1").End(xlDown)
        For j = 3 To schRes.Range("B3").End(xlDown)
            If schTot.Cells(i, 1).Value = schRes.Cells(1, 2).Value Then
                If schRes.Cells(j, 1).Value = "" Then
                    schTot.Rows(i).Copy
                    schRes.Cells(j, 1).Paste
                    Application.CutCopyMode = False
                    'Exit For
                End If
            End If
        Next j
    Next i
End Sub

CodePudding user response：

Try this:

    Option Explicit

Sub schedule()
    Dim sch As Workbook
    Dim schTot As Worksheet
    Dim schRes As Worksheet
    Dim i As Long
    Dim j As Long
    Dim strMonth As String
    
    With ThisWorkbook
        Set schRes = .Worksheets("Results")
        Set schTot = .Worksheets("Schedule")
    End With
    schRes.Range("A3:C" & schRes.Cells(3, 1).End(xlDown).Row).ClearContents
    strMonth = schRes.Cells(1, 2).Value
    i = 2
    j = 3
    With schTot
        Do Until .Cells(i, 1).Value = ""
            If .Cells(i, 1).Value = strMonth Then
                schRes.Range("A" & j & ":C" & j).Value = .Range("A" & i & ":C" & i).Value
                j = j   1
            End If
            i = i   1
        Loop
    End With
    
End Sub

CodePudding user response：

For your code, you just need to change following things to get it run:

-use "Set" instead of "Let"

Set sch = Thisworkbook
Set schRes = sch.Worksheets("Results")
Set schTot = sch.Worksheets("Schedule")

-return row's number in for loop condition

For i = 1 To schTot.Range("A1").End(xlDown).Row
    For j = 3 To schRes.Range("B3").End(xlDown).Row

Then your code will be ok to run, but if your B3 cell in Results worksheet don't have value or following cells(i.e. B4,B5,B6...) doesn't have vale, your code will run infinitely and crush eventually.

Also, you copy a entire row in loop every single time which contain unnecessary cells. This will horribly slow down your code.

To speed up the code, I recommend to use auto filter to solve the problem:

Sub sechedule()
    Dim sch As Workbook: Set sch = ThisWorkbook
    Dim schTot As Worksheet: Set scTot = sch.Worksheets("Schedule")
    Dim schRes As Worksheet: Set schRes = sch.Worksheets("Results")
    Dim month As String
    
    month = Range("B1").Value 'The month you inputted in Results worksheet
    
    'I suppose you want to paste the result to Results worksheet starting from Cell A3, so the contents will be cleared first each time if somethings are in the result area:
    If Range("A3").Value = "" Then Range("A3:C" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents
    
    With schTot
        .Activate
        .Range("A:C").AutoFilter Field:=1, Criterial:=month 'Choose data for specific month with auto filter
        .Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Destination:=schRes.Range("A3") '<--You can change the paste destination here
        .ShowAllData
        .Range("A:C").AutoFilter 'Cancel auto filter
    End With
    
    schRes.Activate
End Sub