First row of Filtered data not copied VBA Excel

Question

This is my Virtual Basic Application Code from my excel spreadsheet,(You can download it, scroll down)


Sub MakeAbsence()

    Dim template As Worksheet
    Dim data As Worksheet
    Dim output As Worksheet
    Dim output_remain As Worksheet
    Dim teacher_list As Worksheet
    
    Set template = ThisWorkbook.Worksheets("Template")
    Set data = ThisWorkbook.Worksheets("Template_Data")
    Set teacher_list = ThisWorkbook.Worksheets("Template_teacher")
    
    ' Getting Teacher's Names
    Dim teachers_range As Variant
    teachers_range = teacher_list.Range("A2:A5")  'Any idea how to automate this?
    
    ' Loop Through Teacher
    Dim teacher As Variant
    
    For Each teacher In teachers_range
    
        ' Copy Template
        template.Copy After:=Worksheets(Worksheets.Count)
        Set output = ActiveSheet
        output.Name = teacher
        
        ' Change Name
        Dim teacher_range As Range
        Set teacher_range = output.Range("A6").EntireRow.Find("[teacher]", LookIn:=xlValues)
        teacher_range.Value = teacher
      
        ' Filtering data
        data.Range("B1:D" & data.Cells(data.Rows.Count, "C").End(xlUp).Row).AutoFilter Field:=3, Criteria1:=teacher
        
        ' Copying Data
        Dim data_range As Range
        Set data_range = data.Range("B2:C" & data.Cells(data.Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
        If Not data_range Is Nothing Then
            ' Copy the first 14 rows to the output worksheet
            If data_range.Rows.Count > 14 Then
                data_range.Resize(14).Offset(1, 0).Copy Destination:=output.Range("B8")
                
                ' Copy the remaining rows to a new worksheet
                Dim remaining_data_range As Range
                Set remaining_data_range = data_range.Resize(data_range.Rows.Count - 14).Offset(15, 0)
                template.Copy After:=Worksheets(Worksheets.Count)
                
                Set output_remain = ActiveSheet
                output_remain.Name = teacher & "_2"
                remaining_data_range.Copy Destination:=ActiveSheet.Range("B8")
                
                  Dim teacher_range_remain As Range
                  Set teacher_range_remain = output_remain.Range("A6").EntireRow.Find("[teacher]", LookIn:=xlValues)
                  teacher_range_remain.Value = teacher
            Else
                data_range.Offset(1, 0).Copy Destination:=output.Range("B8")
            End If
        End If
        
        ' delete filter
        data.AutoFilterMode = False
        
    Next teacher
    
End Sub

Why My first row doesnt get copied as well? And is there any way to automate this code?

' Getting Teacher's Names
Dim teachers_range As Variant
teachers_range = teacher_list.Range("A2:A5")

This is my data

So anyone know where did Abigail Taylor went?

! Toilet maybe? :/

Here is the GDrive Link for the EXCEL FILES

Tigregalis · Accepted Answer · 2023-03-07T06:46:20.970

1 Configurable / dynamic teacher list

The quick and dirty solution is to find the last row in that worksheet, and do Range("A2:A" & lastRow).

You already do this here:

       ' Filtering data
        data.Range("B1:D" & data.Cells(data.Rows.Count, "C").End(xlUp).Row).AutoFilter Field:=3, Criteria1:=teacher

You just need to adapt that same idea:

    teachers_range = teacher_list.Range("A2:A" & teacher_list.Cells(teacher_list.Rows.Count, "A").End(xlUp).Row)  'Any idea how to automate this?

Alternative

Personally, whenever I deal with a list of things (i.e. "configuration") I always use an Excel Table, as I find them easier to work with than simple spreadsheet ranges, because you can see visually what's inside the table and what's outside the table. After you've created the table (select range, Insert Table) you can access them using ThisWorkbook.Worksheets("WorksheetName").ListObjects("TableName").

2 Missing row

The simplest solution is instead of starting from row 2 (and then offsetting later), you simply start from row 3.

        Set data_range = data.Range("B3:C" & data.Cells(data.Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible)

' ... don't offset
                data_range.Resize(14).Copy Destination:=output.Range("B8")

' ... don't offset
                data_range.Copy Destination:=output.Range("B8")

Why?

data_range is actually a collection of ranges, notice that there's a B2:C2 and a B14:C23; when you offset it, it becomes B3:C3 and B15:C24.

?data_range.Address
$B$2:$C$2,$B$14:$C$23
?data_range.Offset(1,0).Address
$B$3:$C$3,$B$15:$C$24

You're using offset to try to remove B2:C2 but it's actually not doing that, it's just changing the B2:C2 to B3:C3 (B3:C3 is filtered out so it doesn't get copied). B14:C23 needs to stay as it is, but it's being changed to B15:C24 (B24:C24 is filtered out so it doesn't get copied); what you end up with is actually just B15:C23 being copied, which is not what you want.

First row of Filtered data not copied VBA Excel

1 Answers1

1 Configurable / dynamic teacher list

Alternative

2 Missing row

Why?