delete rows vba vlookup

Question

Good afternoon, I have an excel with 3 tables, two of them from which I extract data and one to which I import them. My macro goes through the first two tables (h1 and h2), and if the value is not already in the third one (h3), it copies the data in h3. I want to add a code so that if I also make a modification in h1 or h2 that deletes rows, instead of adding them, the macro deletes them also in h3. I don't know how to do it, could you help me?

Thanks!

Here goes my code:

Option Explicit

Sub Copiar_Filas_2()

'optimizar macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

 'Definir objetos a utilizar'
Dim h1 As Variant, fila_h1 As Long, fila_h2 As Long, fila_h3 As Long, h2 As Variant, i As Integer, j As Integer, k As Integer, h3 As Variant

Set h1 = Sheets("Empleados")
Set h2 = Sheets("Formaciones")
Set h3 = Sheets("Resumen")
fila_h1 = Application.WorksheetFunction.CountA(h1.Range("A:A"))
fila_h2 = Application.WorksheetFunction.CountA(h2.Range("A:A"))
fila_h3 = Application.WorksheetFunction.CountA(h3.Range("A:A"))

'inicializo la variable j

'j = h3.Range("C" & Rows.Count).End(xlUp).Row 'selecciona la primera fila libre en col B

    'comienzo el bucle
h3.Activate
  For i = 2 To fila_h1
    For k = 2 To fila_h2
             
      'compruebo que el valor de h1 es igual a h2
      If h1.Cells(i, 2).Value = h2.Cells(k, 1).Value Then
        
        'compruebo que no estén los datos ya copiados
        If IsError(Application.VLookup(h1.Cells(i, 1) & h2.Cells(k, 2), h3.Range("D1:D3500"), 1, False)) Then
        
          'copio B y la pego
          h2.Cells(k, 2).Copy Destination:=Sheets("Resumen").Cells(fila_h3 + 1, 3)
          h1.Cells(i, 1).Copy Destination:=Sheets("Resumen").Cells(fila_h3 + 1, 1)
          h1.Cells(i, 2).Copy Destination:=Sheets("Resumen").Cells(fila_h3 + 1, 2)
                        
          'aumento la variable j para que vaya a la siguiente fila de la hoja Resumen
          fila_h3 = Application.WorksheetFunction.CountA(h3.Range("A:A"))
        
          Application.CutCopyMode = False
        
        End If
      End If
    Next k
  Next i
    
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False

End Sub

Answer 1

Try this. I have included comments to explain each step.

Option Explicit

Sub Copiar_Filas_2()

    'Optimizar macro
    Application.ScreenUpdating = False
    
    'Definir objetos a utilizar'
    Dim h1 As Worksheet, h2 As Worksheet, h3 As Worksheet
    Dim rows_h1 As Long, rows_h2 As Long
    
    Set h1 = ThisWorkbook.Sheets("Empleados")       'Use ActiveWorkbook if macro is run from a different file.
    Set h2 = ThisWorkbook.Sheets("Formaciones")     'Use ActiveWorkbook if macro is run from a different file.
    Set h3 = ThisWorkbook.Sheets("Resumen")         'Use ActiveWorkbook if macro is run from a different file.
    rows_h1 = h1.Range("A" & Rows.Count).End(xlUp).Row  'To get number of rows in sheet.
    rows_h2 = h2.Range("A" & Rows.Count).End(xlUp).Row  'To get number of rows in sheet.
    rows_h3 = 3500                                      'To get number of rows in sheet.
    
    h3.Range("A2:C" & rows_h3).ClearContents    'Clears h3 sheet A:C columns without the headers.
    
    Dim cell_h1 As Range, cell_h2 As Range      'For looping
    Dim cell_h3 As Range                        'For pasting
    Dim find_str As String
    Dim match_row As Long
    
    Set cell_h3 = h3.Range("A2")                'Starting cell
    
    'comienzo el bucle
    For Each cell_h1 In h1.Range("A2:A" & rows_h1).Cells        'Loops through A column of h1 sheet.
        For Each cell_h2 In h2.Range("A2:A" & rows_h2).Cells    'Loops through A column of h2 sheet.
            
            'compruebo que el valor de h1 es igual a h2
            If cell_h1.Offset(0, 1).Value2 = cell_h2.Value2 Then
            
                find_str = cell_h1.Value2 & cell_h2.Value2          'Concatenates value in h1 and h2.
                match_row = 0                                       'Initial value of match_row.
                
                On Error Resume Next    'If match does not return any value.
                    'Check for match in D column of h3 sheet.
                    match_row = Application.WorksheetFunction.Match(find_str, h3.Range("D1:D3500"), 0)
                On Error GoTo 0
                If match_row > 0 Then
                    cell_h3.Value2 = cell_h1.Value2
                    cell_h3.Offset(0, 1).Value2 = cell_h1.Offset(0, 1).Value2
                    cell_h3.Offset(0, 2).Value2 = cell_h2.Offset(0, 1).Value2
                    
                    '*** Use this instead, if you want to copy other things like formats and data-validation ***
                    'cell_h1.Copy: cell_h3.PasteSpecial xlPasteAll
                    'cell_h1.Offset(0, 1).Copy: cell_h3.Offset(0, 1).PasteSpecial xlPasteAll
                    'cell_h2.Offset(0, 1).Copy: cell_h3.Offset(0, 2).PasteSpecial xlPasteAll
                    
                    Set cell_h3 = cell_h3.Offset(1, 0)              'Goes to next line.
                End If
            End If
            
        Next cell_h2
    Next cell_h1
    
    Application.ScreenUpdating = True
End Sub