Keep column creation to a limit in VBA - excel

Question

I have the following VBA code I compiled based on some stuff I found online.
It works (mostly) as I intend it to, as on change in column H it creates a new column to the right of the last column, in the active row, with the latest value.
However, I'd like, if possible, the following:
to keep only the latest 5 changes;
currently, it somehow always ignores the fact that the last column of the active row is empty and just creates a new column after so my updates always look like this, even if each of them is the first update for each row (I can expand if this wasn't clear enough).
Here's the VBA code I have now:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H:H")) Is Nothing Then
ActiveCell.Offset(-1, 0).Activate
a = Sheets("SORTIES").Cells(ActiveCell.Row, Columns.Count).End(xlToLeft).Column + 1
Column = Split(Cells(1, a).Address, "$")(1)
Sheets("SORTIES").Range(Column & ActiveCell.Row).Value = ActiveCell.Value
ActiveCell.Offset(0, 0).Select
End If
End Sub

Answer 1

Please, try the next code. It determines the last empty column inside the table and uses a Static dictionary variable, to keep records for all the cells in the table, for H:H column. It needs a reference to "Microsoft Scripting Runtime". To add this reference you need to be in VBE (Visual Basic for Applications Editor) and go Tools (menu) -> References..., scroll down until find "Microsoft Scripting Runtime" library, check it and press OK.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Static dictSt As New Dictionary 'it needs a reference to "Microsoft Scripting Runtime"
If Target.cells.count > 1 Then Exit Sub
If Target.Address = "$E$1" And Target.Value = "x" Then dictSt.RemoveAll: Target.Value = "": Exit Sub 'clear the dictionary
If Not Intersect(Target, Range("H:H")) Is Nothing Then
Dim lstO As ListObject: Set lstO = ActiveSheet.ListObjects(1) 'use your table namem if there is not only one
If dictSt.count = 0 Then 'load the dictionary for first time
'load the dictionary referenced cells
Dim arrRng As Range, i As Long, cel As Range
Set arrRng = Intersect(lstO.DataBodyRange, Range("H:H"))
For Each cel In arrRng.cells
dictSt(cel.Address) = 0
Next
End If
If Not Intersect(Target, lstO.DataBodyRange) Is Nothing Then
Dim lastEmptRng As Range
Set lastEmptRng = cells(lastListCol(Target, lstO)(0), lastListCol(Target, lstO)(1))
'operate the change in the dictionary and use the last history value after 5 records
If dictSt(Target.Address) >= 5 Then
Dim arrVal As Variant, arrUpdate As Variant, El
arrVal = Range(Target.Offset(0, 1), cells(Target.row, lastEmptRng.Column - 1)).Value
ReDim arrUpdate(1 To 1, 1 To UBound(arrVal, 2))
For i = 1 To UBound(arrVal, 2) - 1
arrUpdate(1, i) = arrVal(1, i + 1)
Next
arrUpdate(1, 5) = Target.Value
With Application
.EnableEvents = False
.Calculation = xlCalculationManual
Range(Target.Offset(0, 1), cells(Target.row, lastEmptRng.Column - 1)).Value = arrUpdate
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Else
lastEmptRng.Value = Target.Value
dictSt(Target.Address) = dictSt(Target.Address) + 1
End If
Target.Select
End If
End If
End Sub
Private Function lastListCol(tg As Range, lstO As ListObject) As Variant
'this piece of code search the last empty column (of the Target row) inside the table!
Dim listRow As Long, fRng As Range
listRow = tg.row - lstO.DataBodyRange.row + 1
Set fRng = lstO.DataBodyRange.rows(listRow).Find(What:="*", _
After:=lstO.DataBodyRange.cells(listRow, 1), LookIn:=xlValues, _
searchorder:=xlByColumns, SearchDirection:=xlPrevious)
If Not fRng Is Nothing Then
lastListCol = Array(tg.row, fRng.Column + 1) ' Stop
Else
lastListCol = Array(tg.row, lstO.DataBodyRange.cells(listRow, 1).Column)
End If
End Function
The dictionary can be reset by typing "x" in cell "E1"!
Edited:
Now, it keeps the last records for all recording history.