I'm importing data into excel from an online phone log. It basically looks like this:
Date Time Duration Local Identity Number
14.12.2016 11:11 00:03 88821354@192.168.1.2 22252797
14.12.2016 10:33 00:02 88821354@192.168.1.2 25322678
I've successfully imported the data into Excel. However, the phone log itself is really annoying in that it only keeps data from the most recent call to any given number. I.e. if I make a call to the second number on the list above (25322678), I will lose the data on the previous call (made at 10:33). And this will be mirrored in Excel.
I am wondering whether there's a way to continuosly import new data without overwriting the old. It seems to me like there's no way of doing this by tweaking the import settings, so I'm considering different workarounds. I haven't been able to come up with anything remotely capable of this yet though.
This solution creates a worksheet named “PhoneLog” to hold the accumulated results of the "From web" function.
This procedure assumes that the results of the "From web" function are located in a worksheet named “WebFrom” in range A:E starting at row 1 (change as required)
This procedure must be located in the same workbook holding the results of the "From web" function.
Run this procedure the first time before updating the "From web" function in order to add the actual results to the "PhoneLog". Thereafter run this procedure immediately after the "From web" function.
This procedure creates the “PhoneLog” worksheet if it’s not found in the workbook. Then it adds to “PhoneLog” all new records from the “WebFrom” worksheet (change as required).
Option Explicit
Sub Phone_Log()
Const kWebFrom As String = "WebFrom" 'change as required
Const kPhoneLog As String = "PhoneLog" 'change as required
Dim wshWeb As Worksheet, wshLog As Worksheet
Dim blwshNew As Boolean
Dim rWeb As Range, rLog As Range
Dim aWeb As Variant, vItm As Variant
Dim lRow As Long, l As Long
Rem Set Worksheets
With ThisWorkbook
Set wshWeb = .Worksheets(kWebFrom)
On Error Resume Next
Set wshLog = .Worksheets(kPhoneLog)
On Error GoTo 0
If wshLog Is Nothing Then
blwshNew = True
Set wshLog = .Worksheets.Add(After:=wshWeb)
wshLog.Name = kPhoneLog
End If: End With
Rem Set FromWeb Array
With wshWeb
If Not (.AutoFilter Is Nothing) Then .Cells(1).AutoFilter
Set rWeb = .Cells(1).CurrentRegion
End With
With rWeb
.AutoFilter Field:=1, Criteria1:="<>"
Set rWeb = .Cells.SpecialCells(xlCellTypeVisible)
aWeb = .Offset(1).Resize(-1 + .Rows.Count).SpecialCells(xlCellTypeVisible).Value2
.AutoFilter
End With
Rem Set Log Array
With wshLog
If blwshNew Then
Rem Set Log - First Time
rWeb.Copy
.Cells(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
.Cells(1).CurrentRegion.Columns.AutoFit
Else
Rem Add New Records into Log Range
Set rLog = .Cells(1).CurrentRegion
With rLog
lRow = .Rows.Count
For l = 1 To UBound(aWeb)
vItm = WorksheetFunction.Index(aWeb, l, 0)
'Use this line if running the "FromWeb" function for one IP address only
'If WorksheetFunction.CountIfs(.Columns(1), vItm(1), _
.Columns(2), vItm(2), .Columns(5), vItm(5)) = 0 Then
'Use this line if running the "FromWeb" function for several IP addresses
If WorksheetFunction.CountIfs(.Columns(1), vItm(1), _
.Columns(2), vItm(2), .Columns(4), vItm(4), .Columns(5), vItm(5)) = 0 Then
lRow = 1 + lRow
.Rows(lRow).Value = vItm
End If: Next: End With
Rem Format Log Range
Set rLog = .Cells(1).CurrentRegion
With rLog
.Rows(2).Copy
.Offset(1).Resize(-1 + .Rows.Count).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
.Columns.AutoFit
End With
Rem Sort Log Range
With .Sort
.SortFields.Clear
.SortFields.Add Key:=rLog.Columns(1), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
.SortFields.Add Key:=rLog.Columns(2), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
'Use also this line if running the "FromWeb" function for several IP addresses
.SortFields.Add Key:=rLog.Columns(4), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rLog
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With: End If: End With
End Sub
Suggest to read the following pages to gain a deeper understanding of the resources used:
Excel Objects, For Each...Next Statement, If...Then...Else Statement,
On Error Statement, Option Explicit Statement,
Range Object (Excel), Range.CurrentRegion Property (Excel), Range.Offset Property (Excel),
Range.PasteSpecial Method (Excel), Range.SpecialCells Method (Excel),
Using Arrays, Variables & Constants, With Statement, Workbook Object (Excel),
Worksheet.AutoFilter Property (Excel), Worksheet.Sort Property (Excel),