A Semi automated way to note the IP addresses of things viewing us

**DocAElstein** · 01-17-2026, 04:48 PM

Later

**DocAElstein** · 01-20-2026, 03:28 AM

I am only giving a general account of the changes I did, as I am still developing the coding and hope to start again from scratch soon, as it is all a bit haphazardly cobbled together as I go along.

Changes in
Sub GetRefreshesIPAddressWatchingThingsAtExcelFox()
In Worksheet code module , Request , in file
IPAddressesWatchingExcelFox_Refresh.xls

Keeping a track of the View count, ViewCnt
As the Bots have both increased recently their view count and the speed at which they do something else, it is difficult to keep up.
So…
I added another worksheet, ViewsCnt, in the file I fill one or more times a day
, along with a bit of extra coding to fill it.
( This extra coding is in the macro run one or more times a day
Sub GetRefreshesIPAddressWatchingThingsAtExcelFox() )
There are two main half bits of that extra coding:
_a) getting the View count as we go along each refresh looping….._
_.....Going back to the start of this thread , looking at what we got in the clipboard on a quick select all and copy of this forum site page
( https://www.excelfox.com/forum/showt...ll=1#post25053
https://www.excelfox.com/forum/showt...ll=1#post25054
https://www.excelfox.com/forum/showt...ll=1#post25055
https://www.excelfox.com/forum/showt...ll=1#post25056 )
, it looks like this bit is reliable to get the number of views

Code:

 "1 members and 897 guests" & vbCr & vbLf
"Most users ever online was 81968" & "," & " 06" & "-" & "16" & "-" & "2025 at 11" & ":" & "54 AM" & "." & vbCr & vbLf
vbCr & vbLf

, or rather some sub part of it such as

Code:

" guests" & vbCr & vbLf & "Most users ever online was "

here is the main first half coding

Code:

  ' 2a(i)_a)  get the current view count to paste in as we go along in  ViewsCnt  Worksheet. (I will probably (NOT, Maybe later) keep a few here to get some idea of any trend, but I may delete a few if it gets too big
        If InStr(1, StringBack, " guests" & vbCr & vbLf & "Most users ever online was ", vbBinaryCompare) > 0 Then
         Let spPos = InStr(1, StringBack, " guests" & vbCr & vbLf & "Most users ever online was ", vbBinaryCompare)
        Dim ViewCnt As String
         Let ViewCnt = Left(StringBack, spPos)
         Let stPos = InStr(1, ViewCnt, " members and ", vbBinaryCompare) + 13
         Let ViewCnt = Mid(ViewCnt, stPos, (spPos - stPos))
        Dim WsV As Worksheet: Set WsV = ThisWorkbook.Worksheets("ViewsCnt")
        WsV.Activate: WsV.Select
        Dim NxtVsClm As Long: If Refresh = 1 Then Let NxtVsClm = WsV.Cells.Item(2, WsV.Columns.Count).End(xlToLeft).Column ' done unecerssarily every time, never mind
        Dim NxtVsRw As Long: Let NxtVsRw = WsV.Cells.Item(WsV.Rows.Count, NxtVsClm).End(xlUp).Row + 1
         Let WsV.Cells.Item(NxtVsRw, NxtVsClm) = "Views " & Format(Now, "ddd, dd mmm yyyy      hh:mm "): WsV.Cells.Item(NxtVsRw, NxtVsClm).Offset(0, 1) = ViewCnt

_b) The coding also allows the coding to stop itself at a new hard coded stop count variable, StpCnt , which might occur, for example in some quick peak to a high view count. The reason for this is that I my not be monitoring the running code all the time, and if the view count is suddenly much lower, then that may mean the Bots have finished doing what they were, and taking further measurements may give other results which blur the main thing it was doing: The point of all this is to figure out what they are up to.
Here is that main second half the coding

Code:

    
        '  _b) Now check if are view number has reduced down beyond our given minimum,  StpCnt
             If ViewCnt < StpCnt Then
             Debug.Print "Stopped at views " & ViewCnt & "    ( Refreshes " & Refresh & "(En was " & En & ") )"
             Dim MxVw As Long: Let MxVw = Application.WorksheetFunction.Max(WsV.Cells.Item(2, NxtVsClm).Offset(0, 1).Resize(NxtVsRw - 1))   '     https://www.mrexcel.com/board/threads/does-vba-have-native-functions-for-min-max.1132613/#post-5477619
             Debug.Print "Spt@" & ViewCnt & "En" & Refresh & Format(Now, "ddd,dd,hh:mm") & "," & MxVw
             Exit Sub
             Else
             End If
        Else
        ' assume I have a crap string here and something else later will hopfully handle that
        End If
    ' 2a   (ii) Start and stop, get rid of unwanted at start and end of full string in Clipboard,  StringBack

Changes in
Sub RequestsOrdering()
Sub IPsSaniierung()
Sub UnknownLocationsTotheSummaryFile()
In Worksheet code module Stats , in file
IPAddressesWatchingExcelFox_Refresh.xls

Selecting changes
I have liked so far to do some work manually as I update every few days the summary file, so as to keep an eye on what is going on , and so I run the three codings sequentially in the below order
Sub RequestsOrdering()
Sub IPsSaniierung()
Sub UnknownLocationsTotheSummaryFile()
, manually. The first two put the info in the clipboard and I am left to select top left of where the data should be pasted into the summary file, and the third coding I run manually which puts the data in the worksheet itself.
If I need to run the extra 4th coding then I have to do a bit of range selecting
It is all a bit hap hazard having been developed inefficiently as I went along adding to and modifying the coding. To help speed things up a bit I do some extra selecting in all of those three main codings

A simple coding to call the main three files
I am still wanting for now to do some things manually, but as the first two codings are getting big, it is a bit tedious to scroll down to the codings.
So at the top of the worksheets Stats, I have a simple coding that calls those larger codings sequentially as well as a few other things, for example pasting the values in. So finally I am just left to hit the play button or F5 key to move things along

Code:

Sub FillSummaryRequestsIPsDailys_xlsm()
Call RequestsOrdering
Stop
Selection.PasteSpecial Paste:=xlPasteValues:             ActiveCell.Offset(0, 3).Select
Application.Wait Time:=Now + TimeValue("00:00:01")
Call IPsSaniierung
Stop
Selection.PasteSpecial Paste:=xlPasteValues:             ActiveCell.Offset(0, 6).Select
Application.Wait Time:=Now + TimeValue("00:00:03")
Call UnknownLocationsTotheSummaryFile                 '  ActiveCell.Offset(30, 0).Select  ' wont work as  UnknownLocationsTotheSummaryFile  closs th file
End Sub

I think those changes will do for now, while I use the codings to catch up. By catching up I mean for now getting all the results from files I make daily into the summary file,

SummaryRequestsIPsDailys.xlsm
, and then I need to think of getting the other summary file up to date
SummaryRequestsIPsAlls(Merge)B.xlsm

, and along the way I need to try and at least get some conclusions to help me think of how to do some more updates and changes

**DocAElstein** · 01-20-2026, 05:42 PM

spare post

**DocAElstein** · 01-27-2026, 09:05 PM

Here the current full codings from the Stats worksheet code module which are called from the new
Sub FillSummaryRequestsIPsDailys_xlsm()
, and there has been no significant changes in those, just a few simple things like selection lines to make my semi manual running a bit easier.

Code:

Sub RequestsOrdering() ' You need something like  SummaryRequestsIPsDailys.xlsm  open
Dim WsReq As Worksheet, WsIP As Worksheet, WsReqErr As Worksheet ' , WsSts As Worksheet
 Set WsReq = ThisWorkbook.Worksheets("Requests"): Set WsIP = ThisWorkbook.Worksheets("IPAddresses"): Set WsReqErr = ThisWorkbook.Worksheets("UnkownLocations")
Dim LrReq As Long, LrIP As Long, LrReqErr As Long
 Let LrReq = WsReq.Range("B" & WsReq.Rows.Count & "").End(xlUp).Row: LrIP = WsIP.Range("B" & WsIP.Rows.Count & "").End(xlUp).Row: Let LrReqErr = WsReqErr.Range("B" & WsReqErr.Rows.Count & "").End(xlUp).Row
 Let WsReq.Range("A1") = WsReq.Range("A1").Value & " " & ThisWorkbook.Name

WsReq.Activate
 Let WsReq.Range("A1") = Replace(ThisWorkbook.Name, ".xls", "", 1, -1, vbBinaryCompare)
 Let WsReq.Range("A1") = Replace(WsReq.Range("A1").Value, "IPAddressesWatchingExcelFox_Refresh", "", 1, -1, vbBinaryCompare)
 Let WsReq.Range("B1:C1") = "" ' I don't want this info messing up the little space I have for title info, it is legacy here to remind me of somethhing, not sure what

Dim rngReq As Range ' The three column range
 Set rngReq = WsReq.Range("A2:C" & LrReq & "")
 
 Let rngReq.WrapText = False ' all request lines same small/ normal height height
 Let WsReq.Range("A" & LrReq + 1 & "") = "=sum(A2:A" & LrReq & ")"
 rngReq.Sort Key1:=WsReq.Range("A2:A" & LrReq & ""), Order1:=xlDescending

 rngReq.Offset(-1, 0).Resize(rngReq.Rows.Count + 1, rngReq.Columns.Count).Copy

 Application.Wait Time:=Now + TimeValue("00:00:04")
Dim Ws As Worksheet: Set Ws = Workbooks("SummaryRequestsIPsDailys.xlsm").Worksheets("Requests")
Ws.Activate
 Application.Wait Time:=Now + TimeValue("00:00:01")
Dim NxtClm As Long: Let NxtClm = Ws.Cells.Item(1, Ws.Columns.Count).End(xlToLeft).Column
 Ws.Cells.Item(1, NxtClm + 3).Select
End Sub
'     C:\Users\Elston\AppData\Roaming\Microsoft\Windows\Network Shortcuts
'  showthread.php?t=2993/Alan and Clare Testing

Sub IPsSaniierung() ' To tidy up after coding
Rem 0 worksheets info
Dim WsReq As Worksheet, WsIP As Worksheet, WsReqErr As Worksheet, WsSts As Worksheet
 Set WsReq = ThisWorkbook.Worksheets("Requests"): Set WsIP = ThisWorkbook.Worksheets("IPAddresses"): Set WsReqErr = ThisWorkbook.Worksheets("UnkownLocations"): Set WsSts = ThisWorkbook.Worksheets("Stats")
WsSts.Cells.ClearContents
Dim LrReq As Long, LrIP As Long, LrReqErr As Long, LrSts As Long
 Let LrReq = WsReq.Range("B" & WsReq.Rows.Count & "").End(xlUp).Row: LrIP = WsIP.Range("B" & WsIP.Rows.Count & "").End(xlUp).Row: Let LrReqErr = WsReqErr.Range("B" & WsReqErr.Rows.Count & "").End(xlUp).Row
Dim LcSts As Long, NxtClm As Long
 Let LcSts = WsSts.Cells.Item(1, WsSts.Columns.Count).End(xlToLeft).Column
 Let NxtClm = LcSts + 1

 WsSts.Activate
 Let WsSts.Range("A1").Offset(0, NxtClm - 1) = Replace(ThisWorkbook.Name, ".xls", "", 1, -1, vbBinaryCompare) ' But iof legacy to when I might have had more / previous columns ion this worksheet
 Let WsSts.Range("A1").Offset(0, NxtClm - 1) = Replace(WsSts.Range("A1").Offset(0, NxtClm - 1), "IPAddressesWatchingExcelFox_Refresh", "", 1, -1, vbBinaryCompare) ' But iof legacy to when I might have had more / previous columns ion this worksheet

Dim rngIPs As Range
 Set rngIPs = WsIP.Range("A2:B" & LrIP & "")
 rngIPs.Copy Destination:=WsSts.Range("A2").Offset(0, NxtClm - 1)
 Set rngIPs = WsSts.Range("A2").Offset(0, NxtClm - 1).Resize(rngIPs.Rows.Count, rngIPs.Columns.Count)
 Let LrSts = LrIP
' Rem Tidy up duplicate IP entries, based on assuming the order has been done on IPs  in   Sub GetRefreshesIPAddressWatchingThingsAtExcelFox()
Dim Cnt As Long
    For Cnt = LrSts To 2 Step -1
    Dim strIP1 As String, strIP2 As String
     Let strIP1 = WsSts.Range("C" & Cnt & "").Value2: strIP2 = WsSts.Range("C" & Cnt + 1 & "").Value2
'    Debug.Print
'    Debug.Print Len(strIP1)
     Let strIP1 = Replace(strIP1, vbTab, "", 1, -1, vbBinaryCompare) ': Debug.Print Len(strIP1)
     Let strIP1 = Replace(strIP1, vbCr & vbLf, "", 1, -1, vbBinaryCompare) ': Debug.Print Len(strIP1)
     Let strIP1 = Trim(strIP1) ': Debug.Print Len(strIP1)
'    Debug.Print
'    Debug.Print Len(strIP2)
     Let strIP2 = Replace(strIP2, vbTab, "", 1, -1, vbBinaryCompare) ': Debug.Print Len(strIP2)
     Let strIP2 = Replace(strIP2, vbCr & vbLf, "", 1, -1, vbBinaryCompare) ': Debug.Print Len(strIP2)
     Let strIP2 = Trim(strIP2) ': Debug.Print Len(strIP2)
'    Debug.Print
        If strIP1 = strIP2 Then
         Let WsSts.Range("B" & Cnt & "") = WsSts.Range("B" & Cnt & "").Value2 + WsSts.Range("B" & Cnt + 1 & "").Value2
         Let WsSts.Range("C" & Cnt & "") = strIP1 ' The sanitised value
         WsSts.Range("B" & Cnt + 1 & ":C" & Cnt + 1 & "").Delete Shift:=xlUp ' W deleted what was behiud/above us
        Else
        End If
    
    Next Cnt
Rem  We lost some rows now, so the last row has changed
 Let LrSts = WsSts.Range("B" & WsSts.Rows.Count & "").End(xlUp).Row
 
Rem  re-order
 Set rngIPs = WsSts.Range("B2:C" & LrSts & "")
 rngIPs.Sort Key1:=rngIPs.Columns(1), Order1:=xlDescending

Rem
' Let WsSts.Range("B" & LrSts + 1 & "") = "=SUM(B2:B" & LrSts & ")"
 Let WsSts.Range("B" & LrSts + 1 & "") = WsSts.Evaluate("SUM(B2:B" & LrSts & ")")
Rem get ready to paste in summary file
 rngIPs.Offset(-1, 0).Resize(rngIPs.Rows.Count + 2, rngIPs.Columns.Count).Copy
Application.Wait Time:=Now + TimeValue("00:00:04")
Dim Ws As Worksheet: Set Ws = Workbooks("SummaryRequestsIPsDailys.xlsm").Worksheets("IPs")
Ws.Activate
Application.Wait Time:=Now + TimeValue("00:00:01")
 Let NxtClm = Ws.Cells.Item(1, Ws.Columns.Count).End(xlToLeft).Column
Ws.Cells.Item(1, NxtClm + 2).Select

End Sub


Sub UnknownLocationsTotheSummaryFile()
Dim DailyWb As Workbook, DailyWs As Worksheet
 Set DailyWb = Me.Parent
 Set DailyWs = DailyWb.Worksheets("UnkownLocations")
 DailyWs.Activate
Dim DlyLr As Long: Let DlyLr = DailyWs.Range("B" & DailyWs.Rows.Count & "").End(xlUp).Row '
Dim rngDly As Range
 Set rngDly = DailyWs.Range("A2:C" & DlyLr & "")
 rngDly.Sort Key1:=DailyWs.Range("A2:A" & DlyLr & ""), Order1:=xlDescending
    If DlyLr > 1 Then
     rngDly.Copy
    Else
     Let DailyWs.Range("A1") = DailyWs.Range("A1").Value  ' A quick trick to change something so that the last change date changes in file explorer
    End If
' rngDly.Offset(50, 0).Select ' To check to see if this effectively scroll



Dim WsS As Worksheet: Set WsS = Workbooks("SummaryRequestsIPsDailys.xlsm").Worksheets("UnknownLocations")
 WsS.Activate
Dim Nr As Long
 Let Nr = WsS.Range("A" & WsS.Rows.Count & "").End(xlUp).Row + 1  '  WsS.Range("B" & WsS.Rows.Count & "").End(xlUp).Row + 1  Bis an option to overwite the column A  of  the day before
 Let WsS.Range("A" & Nr & "") = Replace(Replace(DailyWs.Parent.Name, "IPAddressesWatchingExcelFox_", ""), ".xls", "")
' WsS.Range("A" & Nr & "").Offset(13, 0).Select
    If DlyLr > 1 Then
    WsS.Paste Destination:=WsS.Range("A" & Nr + 1 & "")
    Else
    End If


' Call ReCheckDuplicates

 Let WsS.Cells.WrapText = False


' Now select the data rows just been put in, to make it easier if there is a lot to select ##
 WsS.Activate: WsS.Range("A" & Nr & "").Select
Application.Wait Time:=Now + TimeValue("00:00:01")
Dim Lr As Long: Let Lr = WsS.Range("A" & WsS.Rows.Count & "").End(xlUp).Row
    If Nr = Lr Then
    ' Nothing was pasted in so nothing to select
    Else
     WsS.Range("A" & Nr + 1 & ":A" & Lr & "").Select
    End If

' ActiveCell.Offset(30, 0).Select ' Trick to get things in focus but that fucks up the   ## select the data rows just been put in, to make it easier if there is a lot to select
DailyWs.Parent.Close savechanges:=True
End Sub

**DocAElstein** · 01-27-2026, 09:08 PM

spare post

**DocAElstein** · 01-27-2026, 09:10 PM

Codings and current changes update to
SummaryRequestsIPsAlls(Merge)_______.xlsm

This is the file I update occasionally, and in doing so try to consolidate daily measurements following a trend or strategies etc.
This helps me update the posts from about here, https://www.excelfox.com/forum/showt...ll=1#post27694
Those are the posts attempting to be monitoring in words what the Bots are up to daily or weekly, or for( If any trend/ strategy period

So far I run a couple of sets of codings to fill the two worksheets, AllIPs, and AllRequests ……..

Worksheet AllIPs code module
Sub CopyTLIPsToAllIPs()
Sub SingleIPList()
Sub SortOf()

Worksheet AllRequests code module
Sub CopyTLReqToAllReq()
Sub SingleReqListDics()
Sub SortOf()

As I have recently been catching up on this file, I have been thinking of things to change, update, or add etc. …..

_a) Monthly files
Although this is approximately half the size currently of the dailys file, ( SummaryRequestsIPsDailys.xlsm ) , it will become much bigger, and is already appearing to have size related problems
So I think I will keep it to about a two month size, centred around each month. So there will be some overlap.( I would prefer to have kept it all on one file. Perhaps later I can try to make a single file again… )
The first is from July 2025, meaning it is from about the start of automated measurements and into August

_b) Partial IPs
The first half of an IP address is called a network part, and seems to be the main bit that might crudely in a Layman way of speaking be called a Bot. I have been looking and manually noting those mostly appearing. Some additional coding / coding changes could help with this.
___b)(i) I am thinking I could develop a coding to maybe list in order. Perhaps in the immediate window or in a another worksheet or both another IP list using just the first half. Perhaps a new worksheet named Stats. This coding I will a few posts down
___b)(ii) A snag to b)(i) is that the list in worksheet AllIPs has something sometimes…._
________........ probably a vbTab

Actually that is not a problem, what is a problem is that I was stupidly doing LookAt:=xlWhole whish is Match entire cell contents whereas I should have been doing LookAt:=xlPart : In the coding , the thing I am looking for is the stripped down number, thus

Code:

    Dim Wot As String
     Let Wot = Replace(wsAllIPs.Cells(Cnt, NxtClm + 1).Value2, vbTab, "", 1, -1, vbBinaryCompare)
     Let Wot = Replace(Wot, vbCr & vbLf, "", 1, -1, vbBinaryCompare)
     Let Wot = Trim(Wot)
     Set rngFnd = rngSrch.Find(What:=Wot, After:=wsAllIPs.Cells(Cnt + 1, NxtClm + 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
        Do While Not rngFnd Is Nothing
         Let wsAllIPs.Cells(Cnt, NxtClm) = wsAllIPs.Cells(Cnt, NxtClm) + rngFnd.Offset(0, -1).Value ' Hits
         rngFnd.Offset(0, -1).Resize(1, 2).Delete Shift:=xlUp ' Delete duplicate row after adding hits and ip addresses

So I will not catch any numbers in the list with something like a vbTab tacked on it. So I fucked up.

Just to clarify: Run the following coding on a spare worksheet.
It puts this in the first cell, 6 times, 43.156.168.86

The coding may or may not tack on the end a vbTab or vbLf
The VBA .Find in the coding is always trying to find ( 6 times ) just that number, 43.156.168.86, with nothing tacked on.

' When using LookAt:=xlWhole, the first three uses of .Find , it will only find that if only 43.156.168.86 is in the first cell.

' When using LookAt:=xlPart, the next three uses of .Find, it will always find 43.156.168.86regardless of whether w have just that number or that number with anything tacked on

The coding tells us the address if it finds it.

Code:

Sub Finding() ' Run on a spare worksheet
Dim rngFnd As Range, rngSrch As Range
' LookAt:=xlWhole
 Let ActiveSheet.Range("A1") = "43.156.168.86"
 Set rngSrch = ActiveSheet.Range("A1:A10")
 Set rngFnd = rngSrch.Find(What:="43.156.168.86", After:=ActiveSheet.Range("A10"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
    If Not rngFnd Is Nothing Then
    Debug.Print rngFnd.Address
    Else
    Debug.Print "---"
    End If
 Let ActiveSheet.Range("A1") = "43.156.168.86" & vbTab
 Set rngSrch = ActiveSheet.Range("A1:A10")
 Set rngFnd = rngSrch.Find(What:="43.156.168.86", After:=ActiveSheet.Range("A10"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
    If Not rngFnd Is Nothing Then
    Debug.Print rngFnd.Address
    Else
    Debug.Print "---"
    End If
 Let ActiveSheet.Range("A1") = "43.156.168.86" & vbLf
 Set rngSrch = ActiveSheet.Range("A1:A10")
 Set rngFnd = rngSrch.Find(What:="43.156.168.86", After:=ActiveSheet.Range("A10"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
    If Not rngFnd Is Nothing Then
    Debug.Print rngFnd.Address
    Else
    Debug.Print "---"
    End If
    
Debug.Print

' LookAt:=xlPart
 Let ActiveSheet.Range("A1") = "43.156.168.86"
 Set rngSrch = ActiveSheet.Range("A1:A10")
 Set rngFnd = rngSrch.Find(What:="43.156.168.86", After:=ActiveSheet.Range("A10"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
    If Not rngFnd Is Nothing Then
    Debug.Print rngFnd.Address
    Else
    Debug.Print "---"
    End If
 Let ActiveSheet.Range("A1") = "43.156.168.86" & vbTab
 Set rngSrch = ActiveSheet.Range("A1:A10")
 Set rngFnd = rngSrch.Find(What:="43.156.168.86", After:=ActiveSheet.Range("A10"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
    If Not rngFnd Is Nothing Then
    Debug.Print rngFnd.Address
    Else
    Debug.Print "---"
    End If
 Let ActiveSheet.Range("A1") = "43.156.168.86" & vbLf
 Set rngSrch = ActiveSheet.Range("A1:A10")
 Set rngFnd = rngSrch.Find(What:="43.156.168.86", After:=ActiveSheet.Range("A10"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
    If Not rngFnd Is Nothing Then
    Debug.Print rngFnd.Address
    Else
    Debug.Print "---"
    End If





 Let ActiveSheet.Range("A1").WrapText = False
End Sub

Here is the 6 results

Code:

$A$1
---
---

$A$1
$A$1
$A$1

So, I probably want to start again, and do both the new coding idea ( ___b)(i) ) and correct the Sub SingleIPList() , and while I am at it, do a Sub SingleIPListDics() , as there is since Xmas 2025 a lot of high view counts to consider.

I will effectively "retire" the SummaryRequestsIPsAlls(Merge)B.xlsm here

Share ‘SummaryRequestsIPsAlls(Merge)B.xlsm’ https://app.box.com/s/nc9nu7ifqbp907oq3ixyl0lcz6ne7go5

**DocAElstein** · 01-29-2026, 02:34 PM

A quick repair
I don't feel like redoing all the previous IP worksheet measurements, but I think if I do a simple temporary change to the Sub SingleIPList() , and from now on the file is named
SummaryRequestsIPsAllsJuly2025.xlsm https://app.box.com/s/y1vhxvzyk3yofqasxhfrfs9xva2oxdhp

This simple temporary change uses the selected top left, ( row 1 ), rather than determining it from a title typed in as the last entry

Code:

' Let NxtClm = wsAllIPs.Cells.Item(1, wsAllIPs.Columns.Count).End(xlToLeft).Column
 Let NxtClm = Selection.Column ' For a manual re run somewhere

, and this is the main permanent changeS

Code:

     Set rngFnd = rngSrch.Find(What:=Wot, After:=wsAllIPs.Cells(Cnt + 1, NxtClm + 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
        Do While Not rngFnd Is Nothing
         Let wsAllIPs.Cells(Cnt, NxtClm) = wsAllIPs.Cells(Cnt, NxtClm) + rngFnd.Offset(0, -1).Value ' Hits
         rngFnd.Offset(0, -1).Resize(1, 2).Delete Shift:=xlUp ' Delete duplicate row after adding hits and ip addresses
         
         ' Same search range again - we have deleted any found row, so if there is a next, then that will be found
         Set rngFnd = rngSrch.Find(What:=Wot, After:=wsAllIPs.Cells(Cnt + 1, NxtClm + 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)

Note: There is a problem with using the data of the sort we have for the IP addresses. – See here
https://www.excelfox.com/forum/showt...ll=1#post27701

A similar temporary change is required for the sort coding, Sub SortOf()

Code:

' Let NxtClm = wsAllIPs.Cells.Item(1, wsAllIPs.Columns.Count).End(xlToLeft).Column
 Let NxtClm = Selection.Column

,and I will need to reselect the top left cell

**DocAElstein** · 01-29-2026, 02:37 PM

Sub SingleIPListDic()

This is a simple example use of a dictionary.
So it might b easy to make a simple explanation of a dictionary in general
We can think, just as a way of a Laymen way of thinking, (not necessarily reflecting it internally accurately), that a dictionary is a 2 column list, and it might help in thinking about it as often in typical uses being ordered back to front compared to how the Human instinct might be.
In the two columns can be similar things, and there is not a great deal of difference in the two columns, just a few differences.
One main difference in the two is that one, called the Key, ( and usually shown in coding on the left (or first column position when using the two column analogy) ), must be unique. It could be thought of as a unique address, (and you may in certain circumstances get an error if you try to make another entry with the same Key as an existing one). The Key could also be thought of the number on a box, and then the dictionary as a collection of such boxes. The Key cannot easily be changed once it is assigned. (As a simple Layman equivalent way of thinking, think of it as once a box has a number written on it with an ink pen, then changing that can be a bit awkward)
So having some sort of address/ Key to get at something, (written on a box as it were), the thing in that something is what is called in a dictionary the Item, ( the thing in the box, as it were ). We can easily change the item, (the thing in the box, as it were)

So that is the basic idea. It is quite easy to understand, but confusion often comes in when using a dictionary, strangely.
Maybe that comes in when in a simple example like this one, things seem to be in an unusual non intuitive order.
In our simple example we are wanting to list the quantities of a number; quantities of an IP address: -how often a particular IP address appears.
IP addresses are unique, so conveniently we can use the key. We do not particularly want to change the Key once we assign it, so that is OK.
The number of times the IP address is used is what we will use the Item for: The purpose of the coding is to consolidate the list, meaning that we end up with a unique list of the IP addresses, and the number of times it appears will be added to the Item, so that the final Item represents the total number of times the IP address appeared.
That just happens to sound a bit confusing to a human as things, items, identifying keys etc., seem in a strange order to how a human might jot things down when making a list manually. After a bit of practice, your brain gets accustomed to the somewhat strange order of things.

So the coding basically goes along the non consolidated list, which is two columns, one an IP address, and the other column the number of times it was used. (As we have a few such lists added to each other at this stage, there may be other entries further down in our list for that particular IP address)

So we go down considering each row. If an IPAddressees, say 43.163.110.88, is not yet used as a Key, such a Key will be assigned, pseudo Like Key = 43.163.110.88, ( a new box with the identifying number 43.163.110.88 will be made , as it were). The Item for that key will initially be the number of times in the other column on that row.
If we come across that same IP address in another row further down, we will not make a new Key for it, since we already have one for that IP address, but rather the Item will be changed to the sum of
the previous number or times it was used( the current Item value + the number of times shown in the other column for this further down row.
Finally the dictionary will hold the results we want: effectively a two column list, IP addresses in one and the total number of times it was used in the other.
The final dictionary allows us to take each column as a 1 dimensional array, and each one we want to convert to a column for pasting out, so we will take the opportunity to effectively swap the columns around, just to help with the confusion.

There are not too many commands relevant to a dictionary for us to know about …..

We make it, using one of two ways, for example the Late Binding way
Dim DicIP As Object
Set DicIP = CreateObject("Scripting.Dictionary")

We can see if a Key already exists, ( using the same key example again, 43.163.110.88 *** )
If DicIP.Exists(43.163.110.88) Then …………
…………..
…

We can make the Key (for the first time), and give it an initial Item
DicIP.Add Key:= 43.163.110.88, Item:= ………..
( In Layman terms, the above code line made a "box" to put something, an "Item" in, and it wrote on the box, 43.163.110.88, the "Key” ) ***

We can change the item of/ at/ in an existing Key "box"
Let DicIP(43.163.110.88) = ………

We can get all the keys or Items in one go into a 1 dimensional array
= DicIP.Keys()
= DicIP.Items()

*** Note: We could, most likely would, run into problems again with "invisible" characters, for example vbTab on the so we will always be doing the stripping/ sanitising of the IP address when used in any code lines. In the case of the dictionary coding, this will mean that our final list of unique IP addresses ( the _ .Keys() array ) will be stripped and, unlike in the spreadsheet interaction coding, we will finally have no such characters in the output results. ( This could happen in the spreadsheet interaction coding if the first time a IP address is used it has such a character: That is used as the final result for that IP address, so will still have that character )

Code:

Sub SingleIPListDic()
Dim StTime As Long: Let StTime = Timer
Rem 0 worksheets info
Dim wsAllIPs As Worksheet
 Set wsAllIPs = ThisWorkbook.Worksheets("AllIPs")
Dim NxtClm As Long ' This assumes I have manualy added some date info, or any info, ONLY in the first column ON ROW 1 of where all the copies ranges go, one on top of the other
 Let NxtClm = wsAllIPs.Cells.Item(1, wsAllIPs.Columns.Count).End(xlToLeft).Column
' Let NxtClm = Selection.Column ' For a manual re run somewhere
Dim Lr As Long
 Let Lr = wsAllIPs.Cells(wsAllIPs.Rows.Count, NxtClm).End(xlUp).Row
Dim rngIPs As Range
 Set rngIPs = wsAllIPs.Cells(4, NxtClm).Resize(Lr - 3, 2)
'rngIPs.Copy ' quick check

Rem 1 Dictionary
'1a) make it
Dim DicIP As Object
 Set DicIP = CreateObject("Scripting.Dictionary")
'1b) fill it
Dim Cnt As Long
    For Cnt = 4 To Lr Step 1
    Dim Wot As String ' For the stripped/ sanitised value ( removal of any "invisible" characters )
     Let Wot = Replace(wsAllIPs.Cells(Cnt, NxtClm + 1).Value, vbTab, "", 1, -1, vbBinaryCompare)
     Let Wot = Replace(Wot, vbCr & vbLf, "", 1, -1, vbBinaryCompare)
     Let Wot = Trim(Wot)
        If Not DicIP.Exists(Wot) Then '
        ' Here the  Key/Item s   pair are made for the first time if this  Key  dos not exist
         DicIP.Add Key:=Wot, Item:=wsAllIPs.Cells(Cnt, NxtClm).Value ' The  Key  is the IP address, the Item is the times it was used
        Else '  Else  here we Add the infomation of times used   if the  Key    already exists.
         '  referring to the Item with this key value           change its value to what it was     added    to the value in this next row
         Let DicIP(Wot) = DicIP(Wot) + wsAllIPs.Cells(Cnt, NxtClm).Value
        End If
    Next Cnt
'1c) manipulating info in/ from final dictionary
Dim DicItms() As Variant, DicKys() As Variant
 Let DicItms() = DicIP.Items(): DicKys() = DicIP.Keys()
Dim arrOut() As Variant: ReDim arrOut(0 To UBound(DicItms()), 1 To 2) ' Variant is important, or else there may be problems in the sort, if for example you  Dim  as string
    For Cnt = 0 To UBound(DicItms())
     Let arrOut(Cnt, 1) = DicKys(Cnt): arrOut(Cnt, 2) = DicItms(Cnt)
    Next Cnt

Rem 2  Output
 rngIPs.Clear
 Let wsAllIPs.Cells.Item(4, NxtClm).Resize(UBound(DicItms()) + 1, 2) = arrOut()
ExtSb:
Me.Cells.Item(1, NxtClm).Select
Debug.Print Lr - 3 & "    " & Int((Timer - StTime) / 60) & "min  " & Format(Now, "ddd dd mmm yyyy hh:nn")
 Let wsAllIPs.Cells(1, NxtClm) = wsAllIPs.Cells(1, NxtClm).Value & "    " & Lr - 3 & "         " & Int((Timer - StTime) / 60) & "min  " & Format(Now, "ddd dd mmm yyyy hh:nn")
End Sub

Sub SortOfDic()
Dim wsAllIPs As Worksheet
  Set wsAllIPs = ThisWorkbook.Worksheets("AllIPs")
Dim NxtClm As Long ' This assumes I have manualy added some date info, or any info, ONLY in the first column on row 1 of where all the copies ranges go, one on top of the other
 Let NxtClm = wsAllIPs.Cells.Item(1, wsAllIPs.Columns.Count).End(xlToLeft).Column
' Let NxtClm = Selection.Column
Dim Lr As Long
 Let Lr = wsAllIPs.Cells(wsAllIPs.Rows.Count, NxtClm).End(xlUp).Row
Dim rngIPs As Range
 Set rngIPs = wsAllIPs.Cells(4, NxtClm).Resize(Lr - 3, 2)
 rngIPs.Sort Key1:=rngIPs.Columns(2), Order1:=xlDescending
 rngIPs.Columns.AutoFit
End Sub

**DocAElstein** · 01-29-2026, 04:37 PM

Testing the new Sub SingleIPListDic()
Probably Problem with the previous coding, LookAt:=xlPart problem
I did a quick comparison with the results fro the new Sub SingleIPListDic() and the previous ( updated ) Sub SingleIPList(). I noticed a problem that I overlooked…..
To explain:-
For the time being, we assume the dictionary versio0n coding, Sub SingleIPListDic(), is working OK
The two list produced appear to be very similar but there is a few discrepancies. I can explain, I think, the discrepancies with an example:
In AE:AF is the original Sub SingleIPList() results
In AG:AH is the corresponding results from the dictionary version, Sub SingleIPListDic()

We appear to have an extra entry in the left list
36 __ "57.141.6.2 "
In fact we do have that further down in the list on the right ( from the dictionary version )
_________________ 57.141.6.2 __ 5

If we now look at the dictionary list, in column AG, assume it is correct for now, and search in that column for 57.141.6.2 , without Match entire cell contents checked.
We then see 10 finds. (Clicking on the entry in that window will take me to the relevant cell so as to actually see it

If we check the number given for those occurrences from column AH , and sum them, we get
7 + 6 + 5 + 5 + 4 + 3 + 2 + 2 + 1 + 1 = 36

So that tells us perhaps what the problem was with Sub SingleIPList() , in the updated LookAt:=xlPart version:
At some point in the coding it was looking for entries of 57.141.6.2. It found it 10 ( 9 actually ) times. It then routinely added the occurrences before deleting that entry. So it was actually deleting different IP addresses.

This sort of problem occurs a few times typically. The final result is missing IP address entries.

I will do an Oops version of the file, in case I want to use it for some reason, then move on and redo all the results, then start again with the AllIPs worksheet
Share ‘SummaryRequestsIPsAllsJuly2025Oops.xlsm’ https://app.box.com/s/t4tqwfrfe9d7sqcbh758ymmzlfh4i47k

Also I will upload here a stripped down version of the file, just to get the result columns used as example in this post discussions

**DocAElstein** · 02-01-2026, 12:00 AM

For the time being I will leave the correction/ comparison of the spreadsheet and dictionary coding here, with a file up to approximately August with pairs of results side by side.

Share ‘SummaryRequestsIPsAllsJuly2025 Transition.xlsm’ https://app.box.com/s/2u1z0xu2w3z8jc58fx1lx0j2gh5xx52d

It does not look initially like it messed up the results too much. The main thing was probably an over estimate of IP addresses of this
57.141………
, in particular one with a single last digit such as
57.141.6.2
That is consistent with the LookAt:=xlPart problem discussed , the problem being that such an IP address will be found in part of other similar but more final digit IP addresses which are then deleted, and their count of appearances falsely added to that of the shorter digit IP address

For now I will trim down the July file,
SummaryRequestsIPsAllsJuly2025.xlsm
, and move on in the next page to a coding to fill a new Stats worksheet to get the IP address List ordered by occurrences of the first half of the IP address.