Controlla valori univoci e copia

[BG66]

Ciao a tutti.
In pratica vorrei:
a) controllare che i nomi presenti in AnagraficaFull" siano gli stessi presenti in "2022" (ovviamente il nome del foglio cambierà seguendo l'anno solare aggiungendosi al precedente) avvisandomi se trova dei mancanti;
b) se in "2022" mancano alcuni di questi, aggiungerli in fondo copiando le impostazioni dalle righe presenti (testo,linee,etc)

Ho abbozzato qualcosina per almeno visualizzare il dato:

Codice: Seleziona tutto

Sub Confronta_Colonne()
Dim Myarr(), Myarr1()
Dim rng As Range, Rng1 As Range
Dim ur As Long, Icount As Long
Dim Elephant As Variant

Application.ScreenUpdating = False
'Columns(3).ClearContents
ur = Foglio10.Range("E" & Rows.Count).End(xlUp).Row
Set rng = Range("E3:E" & ur)
Myarr() = rng
ur = Foglio12.Range("G" & Rows.Count).End(xlUp).Row
Set Rng1 = Range("G3:B" & ur)
ReDim Myarr1(1 To ur)
Icount = 1
For Each Elephant In Myarr
    If Application.WorksheetFunction.CountIf(Rng1, Elephant) = 0 Then
        ReDim Preserve Myarr1(1 To Icount)
        Myarr1(Icount) = Elephant
        Icount = Icount + 1
    End If
Next
If Icount = 1 Then
    MsgBox "Nessun dato trovato"
Else
    Foglio10.Range("z1:z" & Icount - 1).Value = Application.Transpose(Myarr1)
    Foglio10.Range("z:Z").RemoveDuplicates Columns:=1, Header:=xlNo
    MsgBox "Trovati " & Icount - 1 & " valori Univoci"
End If
Application.ScreenUpdating = True
End Sub

Grazie per l'aiuto
Gene
https://www.dropbox.com/scl/fi/n9hdf69srgbxn7eydicm7/Trova_assenti_forum.xlsm?dl=0&rlkey=f8b14a4ybgq51ykamm97rdmih

[Anthony47]

Molte cose le hai lasciate alla nostra libera fantasia...
Con questa premessa ti propongo:

Codice: Seleziona tutto

Sub Confronta_e_Pareggia()
Dim AFRan As Range, Y20XX As Range
Dim URY As Long, URAF As Long
Dim yXXArr(), AFArr(), cMiss As Long, I As Long
'
URY = Foglio10.Cells(Rows.Count, "E").End(xlUp).Row
URAF = Foglio12.Cells(Rows.Count, "G").End(xlUp).Row
'
Set AFRan = Foglio12.Range("G3:G" & URAF)
Set Y20XX = Foglio10.Range("E3:E" & URY)
ReDim AFArr(1 To AFRan.Rows.Count, 1 To 1)
'
For I = 1 To AFRan.Rows.Count
    If Application.WorksheetFunction.CountIf(Y20XX, AFRan.Cells(I, 1)) = 0 Then
        AFArr(I, 1) = "M"
        cMiss = cMiss + 1
        Y20XX.Cells(Y20XX.Rows.Count + cMiss).Resize(1, 4).Value = AFRan.Cells(I, 1).Resize(1, 4).Value   '*** VEDI TESTO 1
    End If
Next I
If cMiss > 0 Then
    formatCopy = 13                                 '<<< Di quante colonne vanno copiate le formattazioni?? *** VEDI TESTO 2
    Y20XX.Cells(Y20XX.Rows.Count, 1).Resize(1, formatCopy).Copy
    Y20XX.Cells(Y20XX.Rows.Count + 1, 1).Resize(cMiss, formatCopy).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
    AFRan.Cells(1, 5).Resize(UBound(AFArr), 1) = AFArr              '*** VEDI TESTO 3
    MsgBox ("Mancanti (e aggiunti): " & cMiss)
Else
    MsgBox ("Completato, nessun mancante")
End If
End Sub


Questa:
-controlla se tutti i nominativi presenti in AnagraficaFull sono presenti in "2022"; se No li aggiunge in coda sull'elenco di "2022" copiando in tutto 4 colonne da AnagraficaFull a 2022 (vedi Testo 1)
-a fine controllo copia la formattazione di N colonne; ho impostato questo N a 13 (Vedi Testo 2)
-a fine controllo, su colonna K di AnagraficaFull scrive "M" accanto ai nominativi che in origine mancavano in 2022 (vedi Testo 3)

Le tre cose marcate "Vedi Testo x" me le sono inventate, perche' non le ho dedotte dal tuo messaggio

Vedi se puo' servire così...

[BG66]

[RISOLTO]
Ciao Anthony,
ovviamente è ok e le tue integrazioni sono gradite sempre e comunque.

Grazie come al solito.

Buon ponte... se te lo concedi!!
Gene