Automatically Scroll Window as Macro Runs

Just for a bit of fun (and to see how calculations were working out), I was trying to get a macro to scroll down the window as it calculated data.


Sadly, ActiveWindow.SmallScroll Down:=2 was too fast and =1 was too slow!

More sadly, that's the only command I know to get this to work.


So, I'm hoping for a demonstration of a different command. Can anyone recommend a way to get the window to scroll automatically to the cell which has just had information inserted into it?

Here's the VBA (kindly bestowed upon me by MickG) :

Sub CustomerCategory()

Dim Rng As Range
Dim Dn As Range
Dim n As Long
Dim Rng2 As Range
Dim Data As Variant
Dim Temp As String
Dim K As Variant
Dim Str As String
Dim oMax As Integer
Dim Dn2 As Range

With Sheets("Brand Categories")
Set Rng2 = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
End With
With ActiveSheet
Set Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
End With


With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
If Not Dn.Value = vbNullString Then
For Each Dn2 In Rng2: .Item(Dn2.Value) = Empty: Next Dn2
Data = Split(Dn, ";")
For n = 0 To UBound(Data)
If .Exists(Data(n)) Then
.Item(Data(n)) = .Item(Data(n)) + 1
End If
Next n

For Each K In .keys
If Not .Item(K) = "" Then
oMax = Application.Max(oMax, .Item(K))
If .Item(K) = oMax Then Temp = K
Str = Str & K & "(" & .Item(K) & "); "
End If

On Error Resume Next

Next K

Dn.Value = Str
Dn.Offset(, 1) = Rng2(Application.Match(Temp, Rng2, 0), 2)
Str = "": Temp = "": oMax = 0: .RemoveAll

'ActiveWindow.SmallScroll Down:=2

End If
Next Dn
End With

End Sub