Numerare progressivamente email arrivate

[Ricky0185]

Buon Pomeriggio,
sto combattendo per numerare progressivamente ed in automatico l'arrivo delle email contestualmente alla registrazione della data di arrivo, per la maggior parte tutte diverse. Registro la data in colonna C e subito automaticamente in colonna B deve venir registrato il numero progressivo dell'email ricevuta. Il file è molto più popolato sia di righe che di colonne e non trovo l'istruzione nella macro per inserire il numero progressivo che ovviamente deve essere superiore di un unità al numero più grande che si trova in colonna B.
Confido nel Vs aiuto.
Saluti
R

[Anthony47]

Puoi usare l'evento Worksheet_Change:
-tasto dx sul tab col nome del foglio
-scegli Visualizza codice per aprire l'editor vba alla pagina giusta
-inserisci questo codice nel frame di destra dell'editor vba:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cLast As Long
'
If Target.Cells(1, 1).Column = 3 Then
    If Target.Cells(1, 1) <> "" Then
        cLast = Application.WorksheetFunction.Max(Range("B:B"))
        If Target.Cells(1, 0).Value = "" Then
            Target.Cells(1, 0).Value = cLast + 1
        End If
    End If
End If
End Sub

In questo modo quando inserisci una data la colonna B verra' compilata. Se la riscrivi ma c'e' gia' un numero, non verra' modificato

Se sbagli e te ne accorgi subito puoi subito cancellare a mano la data e la numerazione. Se invece il "protocollo" e' andato avanti allora e' un casino; la cosa piu' semplice e' che cancelli data e numerazione, poi rimetti la data e ti verra' assegnata la numerazione "corrente", e il vecchio numero rimarra' non assegnato.
Insomma "NON SBAGLIARE"

[Ricky0185]

Io combattevo con questa, sempre con il codice nel Foglio1

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range


    Set KeyCells = Range("c4:C29")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then


'[B25] = WorksheetFunction.Max([b4:b500]) + 1
ActiveCell.Offset(0, -1) = WorksheetFunction.Max([b4:b500]) + 1

End If
End Sub

ma provala e vedrai che scherzetto ti fa
Ora provo la tua

[Ricky0185]

Però sostituendo nella mia macro il mio

Codice: Seleziona tutto

ActiveCell.Offset(0, -1) = WorksheetFunction.Max([b4:b500]) + 1


con il tuo

Codice: Seleziona tutto

Target.Cells(1, 0).Value =WorksheetFunction.Max([b4:b500]) + 1


finalmente funziona.
Poi se sbagli basta che cancelli insieme numero progressivo e data.
E con questo "abbiamo" risolto.
Ciao e grazie
R