Используйте VBA для обновления определенных диапазонов, а не для повторного добавления всех записей.

Мне нужно сделать макрос для входа для ежедневных посещений, но каждый раз, когда я его запускаю, он обновляет существующие записи, а мне нужно обновить только условие else, добавленное для последних 3 значений.

Мне нужно проверить, создан ли текущий пользователь, чтобы пропустить его и добавить только запись устройства. Если нет, добавьте запись.

Это макрос, который я сделал.

Sub LogToDatabase()
    Dim loginSheet As Worksheet
    Dim databaseSheet As Worksheet
    Dim lastLoginRow As Long
    Dim lastDatabaseRow As Long
    Dim i As Long

    ' Определить листы
    Set loginSheet = ThisWorkbook.Sheets("Login Tab")
    Set databaseSheet = ThisWorkbook.Sheets("Database")

    ' Найти последнюю строку с данными в листе входа
    lastLoginRow = loginSheet.Cells(loginSheet.Rows.Count, "A").End(xlUp).Row

    ' Найти последнюю строку с данными в листе базы данных
    lastDatabaseRow = databaseSheet.Cells(databaseSheet.Rows.Count, "A").End(xlUp).Row

    ' Скопировать каждую новую строку с вкладки входа в базу данных
    For i = 2 To lastLoginRow
        ' Проверить, существует ли запись в базе данных
        If Application.WorksheetFunction.CountIf(databaseSheet.Range("D:D"), loginSheet.Cells(i, 4).Value) = 0 Then
            ' Скопировать информацию о пользователе с вкладки входа в базу данных
            databaseSheet.Cells(lastDatabaseRow + 1, 1).Value = loginSheet.Cells(i, 1).Value ' ИМЯ
            databaseSheet.Cells(lastDatabaseRow + 1, 2).Value = loginSheet.Cells(i, 2).Value ' ФАМИЛИЯ
            databaseSheet.Cells(lastDatabaseRow + 1, 3).Value = loginSheet.Cells(i, 3).Value ' ТИП ДОКУМЕНТА
            databaseSheet.Cells(lastDatabaseRow + 1, 4).Value = loginSheet.Cells(i, 4).Value ' ДОКУМЕНТ
            databaseSheet.Cells(lastDatabaseRow + 1, 5).Value = loginSheet.Cells(i, 5).Value ' ТЕЛЕФОН
            databaseSheet.Cells(lastDatabaseRow + 1, 6).Value = loginSheet.Cells(i, 6).Value ' АДРЕС
            databaseSheet.Cells(lastDatabaseRow + 1, 7).Value = 1 ' Всего посещений
            databaseSheet.Cells(lastDatabaseRow + 1, 8).Value = Now() ' Дата последнего посещения
            databaseSheet.Cells(lastDatabaseRow + 1, 9).Value = loginSheet.Cells(i, 7).Value ' УСТРОЙСТВО

            lastDatabaseRow = lastDatabaseRow + 1
        Else
            ' Если запись существует, обновить общее количество посещений и дату последнего посещения
            Dim existingRow As Long
            existingRow = Application.WorksheetFunction.Match(loginSheet.Cells(i, 4).Value, databaseSheet.Range("D:D"), 0)
            databaseSheet.Cells(existingRow, 7).Value = databaseSheet.Cells(existingRow, 7).Value + 1 ' Увеличить общее количество посещений
            databaseSheet.Cells(existingRow, 8).Value = Now() ' Обновить дату последнего посещения
            databaseSheet.Cells(existingRow, 9).Value = databaseSheet.Cells(existingRow, 9).Value & ", " & loginSheet.Cells(i, 7).Value ' Добавить использование устройства
        End If
    Next i
End Sub

Вы можете использовать Match отдельно здесь, без необходимости в Countif:

Sub LogToDatabase()
    Dim loginSheet As Worksheet, databaseSheet As Worksheet
    Dim dbRow As Range, i As Long, m As Variant, doc

    Set loginSheet = ThisWorkbook.Sheets("Login Tab")
    Set databaseSheet = ThisWorkbook.Sheets("Database")

    ' Скопировать каждую новую строку с вкладки входа в базу данных
    For i = 2 To loginSheet.Cells(loginSheet.Rows.Count, "A").End(xlUp).Row
        doc = loginSheet.Cells(i, 4).Value ' документ
        m = Application.Match(doc, databaseSheet.Range("D:D"), 0) ' Попробовать найти совпадение в базе данных

        If IsError(m) Then ' `m` будет значением ошибки, если совпадение не найдено в ColD
            ' Найти следующую пустую строку в базе данных
            Set dbRow = databaseSheet.Cells(databaseSheet.Rows.Count, "A").End(xlUp).Offset(1).EntireRow
            ' Скопировать ИМЯ, ФАМИЛИЯ, ТИП ДОКУМЕНТА, ДОКУМЕНТ, ТЕЛЕФОН, АДРЕС (первые 6 ячеек)
            dbRow.Cells(1).Resize(1, 6).Value = loginSheet.Cells(i, 1).Resize(1, 6).Value
        Else
            Set dbRow = databaseSheet.Rows(m) ' совпадающая строка (для обновления)
        End If
        ' то же самое для нового/обновленного
        dbRow.Cells(7).Value = dbRow.Cells(7).Value + 1  ' Увеличить общее количество посещений
        dbRow.Cells(8).Value = Now()                     ' Дата последнего посещения
        With dbRow.Cells(9)
            .Value = .Value & IIf(Len(.Value) > 0, ",", "") & _
                     loginSheet.Cells(i, 7).Value ' Добавить использование устройства
        End With
    Next i
End Sub