Option Explicit
Public Sub MJ72(ByVal argTarget As Range)
Const CHOICE As String = "OUI" ' <<< choice needs to be coded in uppercase
If argTarget.CountLarge = 1 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With argTarget.Parent
Select Case UCase(.Name)
Case "CALL_LOG" ' <<< Sheet name needs to be coded in uppercase
' check on column L > Nouvel employeur?
If Not Application.Intersect(argTarget, .Columns("L")) Is Nothing Then
If UCase(argTarget.Value) = CHOICE Then
CopyFromCallLogToDataBase argTarget
End If
' check on column N > Devrait-on faire une présence aux activités ?
ElseIf Not Application.Intersect(argTarget, .Columns("N")) Is Nothing Then
If UCase(argTarget.Value) = CHOICE Then
CopyFromCallLogToPrécenceAuxActivitée argTarget
End If
' check on column O > Planifierez-vous un suivi ?
ElseIf Not Application.Intersect(argTarget, .Columns("O")) Is Nothing Then
If UCase(argTarget.Value) = CHOICE Then
CopyFromCallLogToFollowUps argTarget
End If
End If
Case "FOLLOW_UPS"
' check on column V > Archive
If Not Application.Intersect(argTarget, .Columns("V")) Is Nothing Then
If UCase(argTarget.Value) = CHOICE Then
CopyFromFollowUpsToArchives argTarget
End If
' check on column W > Nouvelles Présences aux Activités à faire ?
ElseIf Not Application.Intersect(argTarget, .Columns("W")) Is Nothing Then
If UCase(argTarget.Value) = CHOICE Then
CopyFromFollowUpsToPrecences argTarget
End If
End If
Case "ARCHIVES"
' check on column X > Nouveau Présences aux activités à compléter ?
If Not Application.Intersect(argTarget, .Columns("X")) Is Nothing Then
If UCase(argTarget.Value) = CHOICE Then
CopyFromArchivesToPrecences argTarget
End If
End If
End Select
End With
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If
End Sub
Private Sub CopyFromCallLogToDataBase(ByVal argTarget As Range)
' add a new row to the given table & obtain a reference to that newly added table row
Dim lr As ListRow
Set lr = Range("ShtTblDataBase").ListObject.ListRows.Add
With argTarget.Parent
' |
' column number \|/ within newly added table row of the referenced table
' |
lr.Range.Cells(, 1).Value = .Cells(argTarget.Row, "A").Value
lr.Range.Cells(, 2).Value = .Cells(argTarget.Row, "H").Value
lr.Range.Cells(, 6).Value = .Cells(argTarget.Row, "C").Value
lr.Range.Cells(, 8).Value = .Cells(argTarget.Row, "F").Value
lr.Range.Cells(, 9).Value = .Cells(argTarget.Row, "D").Value
lr.Range.Cells(, 12).Value = .Cells(argTarget.Row, "B").Value
End With
End Sub
Private Sub CopyFromCallLogToPrécenceAuxActivitée(ByVal argTarget As Range)
Dim lr As ListRow
Set lr = Range("ShtTblPrésActiv").ListObject.ListRows.Add
With argTarget.Parent
lr.Range.Cells(, 1).Value = .Cells(argTarget.Row, "H").Value
lr.Range.Cells(, 3).Value = .Cells(argTarget.Row, "A").Value
lr.Range.Cells(, 4).Value = .Cells(argTarget.Row, "C").Value
End With
End Sub
Private Sub CopyFromCallLogToFollowUps(ByVal argTarget As Range)
Dim lr As ListRow
Set lr = Range("ShtTblFollowUps").ListObject.ListRows.Add
' copy only first eleven columns across (A:K)
With argTarget.Parent
lr.Range.Resize(, 11).Value = .Range(.Cells(argTarget.Row, "A"), .Cells(argTarget.Row, "K")).Value
End With
End Sub
Private Sub CopyFromFollowUpsToArchives(ByVal argTarget As Range)
Dim lr As ListRow
Set lr = Range("ShtTblArchives").ListObject.ListRows.Add
' copy only first fourteen columns across (A:N)
With argTarget.Parent
lr.Range.Resize(, 14).Value = .Range(.Cells(argTarget.Row, "A"), .Cells(argTarget.Row, "N")).Value
End With
End Sub
Private Sub CopyFromFollowUpsToPrecences(ByVal argTarget As Range)
With argTarget.EntireRow
Dim MaxDate As Long
MaxDate = MaxOfList(.Range("Q1").Value, _
.Range("S1").Value, _
.Range("U1").Value)
End With
Dim lr As ListRow
Set lr = Range("ShtTblPrésActiv").ListObject.ListRows.Add
With argTarget.Parent
If MaxDate > 0 Then
lr.Range.Cells(, 1).Value = MaxDate
End If
lr.Range.Cells(, 3).Value = .Cells(argTarget.Row, "A").Value
lr.Range.Cells(, 4).Value = .Cells(argTarget.Row, "C").Value
End With
End Sub
Private Sub CopyFromArchivesToPrecences(ByVal argTarget As Range)
With argTarget.EntireRow
Dim MaxDate As Long
MaxDate = MaxOfList(.Range("P1").Value, _
.Range("R1").Value, _
.Range("T1").Value, _
.Range("V1").Value)
End With
Dim lr As ListRow
Set lr = Range("ShtTblPrésActiv").ListObject.ListRows.Add
With argTarget.Parent
If MaxDate > 0 Then
lr.Range.Cells(, 1).Value = MaxDate
End If
lr.Range.Cells(, 3).Value = .Cells(argTarget.Row, "A").Value
lr.Range.Cells(, 4).Value = .Cells(argTarget.Row, "C").Value
End With
End Sub
Public Function MaxOfList(ParamArray argValues() As Variant) As Variant
Dim i As Long, Max As Variant
Max = Null
For i = LBound(argValues) To UBound(argValues)
If VBA.IsNumeric(argValues(i)) Or VBA.IsDate(argValues(i)) Then
If Max >= argValues(i) Then
'do nothing
Else
Max = argValues(i)
End If
End If
Next
MaxOfList = Max
End Function
