Compare columns with discontinuous data.

[24August]

Hi everyone
I got this code on your site.
How can I adapt it if the data is discontinuous in the comparison column (column A of the report sheet).
that is, there are empty cells.
Thank you.

Sub ItzybellDUE()
   Dim Ary As Variant
   Dim i As Long, j As Long
  
   Ary = Sheets("dati").Range("A2").CurrentRegion.Value2
   With Sheets("report")
      j = .Range("A" & Rows.Count).End(xlUp).Row
      For i = UBound(Ary) To 2 Step -1
         If .Cells(j, 1).Value = Ary(i, 1) Then
            j = j - 1
         Else
            Rows(j + 1).Insert
            .Cells(j + 1, 1).Resize(, 2).Value = Array(Ary(i, 1), Ary(i, 2))
         End If
      Next i
   End With
End Sub

 

[Vogateer]

Can you describe what's happening? Is it not performing on the whole range, or is it creating the wrong data? I'm sorry, but it's really hard to help without some sample data and a description and example of the problem.

 

[24August]

This is the code for inserting rows.
Compare column A of the Data Sheet with column K of the Report Sheet.
Differences in column L of the Report Sheet.

Sub Mancanti()
Application.ScreenUpdating = False

    Dim x, y, match As Boolean
    Dim arr As Variant
    Dim stNow As Date
    stNow = Now
    
    Sheets("report").Range("L2:O" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents


    arr = Sheets("dati").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
varr = Sheets("report").Range("K2:K" & Range("k" & Rows.Count).End(xlUp).Row).Value

    For Each x In arr
        match = False
        For Each y In varr
            If x = y Then match = True
        Next y
        If Not match Then
            Sheets("report").Range("L" & Range("L" & Rows.Count).End(xlUp).Row + 1) = x
            Sheets("report").Range("M" & Range("M" & Rows.Count).End(xlUp).Row + 1) = Sheets("dati").Cells(x, 1).Offset(, 1)
            Sheets("report").Range("N" & Range("N" & Rows.Count).End(xlUp).Row + 1) = Sheets("dati").Cells(x, 1).Offset(, 2)
            Sheets("report").Range("O" & Range("O" & Rows.Count).End(xlUp).Row + 1) = Sheets("dati").Cells(x, 1).Offset(, 3)
        End If
    Next


 Application.ScreenUpdating = True
End Sub

'-----------------------------------------------------------------------------------------------------------------------------------------
Sub Xx()
Dim v1, v2, V3(), i As Long, j As Long


Application.ScreenUpdating = False


'progressivo colonna A
With Sheets("report")
    v = 1
    For i = 2 To Sheets("report").Cells(Rows.Count, 1).End(xlUp).Row
             Sheets("report").Cells(i, 1).Value = v
             v = v + 1
    Next
End With


Call Mancanti


a_LastRow = Sheets("report").Cells(Sheets("report").Rows.Count, 12).End(xlUp).Row + 1
For i = a_LastRow - 1 To 2 Step -1 ' header row 1
    'For i = 2 To Sheets("report").Cells(Sheets("report").Rows.Count, "L").End(xlUp).Row + 1
    x1x = Sheets("report").Cells(i, 12)
    x1xdataNumero = Sheets("report").Cells(i, 13)
    x1xdata = Sheets("report").Cells(i, 14)
    x1xdataDescrizione = Sheets("report").Cells(i, 15)
    
    Const col = 11
    Dim sht As Worksheet
    Set sht = Sheets("report")
    rngVal = Range(IIf(IsEmpty(Cells(2, col)), Cells(2, col).End(xlDown), Cells(2, col)), Cells(sht.Rows.Count, col).End(xlUp)).Address
    rngName = Range(IIf(IsEmpty(Cells(2, col)), Cells(2, col).End(xlDown), Cells(2, col)), Cells(sht.Rows.Count, col).End(xlUp)).Address
    
     xMax = Evaluate("MAX(IF(" & rngName & "<" & x1x & "," & rngVal & "))")
     xmin = Evaluate("MIN(IF(" & rngName & ">" & x1x & "," & rngVal & "))")
    
     ur = Sheets("report").Cells(Rows.Count, 1).End(xlUp).Row + 1
    n_rMax = Application.match(xMax, Sheets("report").Range("k2:k" & ur), 1) + 1
    
     Sheets("report").Cells(n_rMax + 1, "A").EntireRow.Insert
     Sheets("report").Cells(n_rMax + 1, "A") = x1xdataNumero
     Sheets("report").Cells(n_rMax + 1, "B") = CDate(x1xdata)
     Sheets("report").Cells(n_rMax + 1, "D") = x1xdataDescrizione
     Sheets("report").Cells(n_rMax + 1, "C") = "FT_" & x1x
    
     Sheets("report").Cells(n_rMax + 1, "J") = x1xdataNumero
      Sheets("report").Cells(n_rMax + 1, "k") = x1x
Next

'progressivo colonna A
With Sheets("report")
    v = 1
    For i = 2 To Sheets("report").Cells(Rows.Count, 1).End(xlUp).Row
             Sheets("report").Cells(i, 1).Value = v
             v = v + 1
    Next
End With

Application.ScreenUpdating = True

End Sub

'------------------------------------------------------------------------------
Unless there's an error on my part, the code below should get the same result, where I'm wrong.

Sub ItzybellDUE()
   Dim Ary As Variant
   Dim i As Long, j As Long
 
   Ary = Sheets("dati").Range("A2").CurrentRegion.Value2
   With Sheets("report2")
   .Activate
      j = .Range("k" & Rows.Count).End(xlUp).Row
      For i = UBound(Ary) To 2 Step -1
         If .Cells(j, 11).Value = Ary(i, 1) Then
            j = j - 1
         Else
                      If .Cells(j, 11).Value = "" Then
                     '  .Cells(j, 11).Interior.ColorIndex = 5
                       j = j - 2
                    
                    .Cells(j + 1, 11).Resize(, 1).Value = Array(Ary(i, 1))
                    Else
                     ' Rows(j + 1).Insert
                       Rows(j + 1).EntireRow.Insert
                     .Cells(j + 1, 11).Resize(, 1).Value = Array(Ary(i, 1))
                      
                      End If
            
         End If
      Next i
   End With
End Sub

 

[24August]

I tried with this code but I get error on this line.

Dim Ary As Variant
Dim i As Long, j As Long
Dim Dic As Object
Dim Cl As Range

Set Dic = CreateObject("scripting.dictionary")
Ary = Sheets("Sheet2").Range("A1").CurrentRegion.Value2
With Sheets("Sheet1")
For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
Set Dic.Item(Cl.Value) = Cl
Next Cl
j = 1
For i = 2 To UBound(Ary)
If Not Dic.Exists(Ary(i, 1)) Then
Dic(Ary(j, 1)).Offset(1).EntireRow.Insert <<<<<<<<<<<<<<<<<<<<<<<error 424 necessary object
Dic(Ary(j, 1)).Offset(1).Resize(, 2).Value = Array(Ary(i, 1), Ary(i, 2))
Else
j = j + 1
End If
Next i
End With
End Sub