简体   繁体   中英

If a cell contains specific value copy certain data into next available row

Similar question to many others. For context, want to use this code to take attendance for students. Ideally a user scrolls through the list and puts a 1 for every absent student. This then populates an absent list.

My code is fairly rudimentary but very close to what I want it to do. However, if more than 1 rows have a "1" in it, then it will pull all data from all rows with a 1 in it. I only want it to pull the row that the 1 is being entered on. I feel like I'm a line of code away from fixing this. Ranges E:J in my active sheet are the data points I need, plus today's date.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Integer

If Not Application.Intersect(Range("A:A"), Target) Is Nothing Then
    For i = 1 To 9999
        If Range("A" & i).Value = 1 Then
            Sheets("Absent List").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Range("E" & i).Value
            Sheets("Absent List").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Range("F" & i).Value
            Sheets("Absent List").Range("C" & Rows.Count).End(xlUp).Offset(1).Value = Range("G" & i).Value
            Sheets("Absent List").Range("D" & Rows.Count).End(xlUp).Offset(1).Value = Range("H" & i).Value
            Sheets("Absent List").Range("E" & Rows.Count).End(xlUp).Offset(1).Value = Range("I" & i).Value
            Sheets("Absent List").Range("F" & Rows.Count).End(xlUp).Offset(1).Value = Range("J" & i).Value
            Sheets("Absent List").Range("G" & Rows.Count).End(xlUp).Offset(1).Value = Date
            End If
            Next i
        End If
End Sub

Thanks,

By looping over column A, you are always going to copy the data when you come across a value of 1.

Instead, if you set i to Target.Row then you will only copy the changes for the row that changed.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim i As Integer

    If Not Application.Intersect(Range("A:A"), Target) Is Nothing Then
        i = Target.Row
        If Range("A" & i).Value = 1 Then
            ' Do your copying
        End If
    End If
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM