Home » excel » vba – 66k lines to analyze in Excel

vba – 66k lines to analyze in Excel

Posted by: admin May 14, 2020 Leave a comment

Questions:

I huge amount of data to analyze!
I have a table “Resolved Met” and on column G with some text that contains a server name
and table “Server List” with 66k name of servers

I have to analyze if the text contains the server name on table “Server List” and if yes to write the server name in front of the text ( in another cell)

What I did was to go to first line of table “Server List” and look for it on column where the text is with a loop

It took more than 6 hours to analyze everything once the I have 66k serves name and 130k lines of text.
Here is my code. Do you have some better idea to make it faster?

Sub ()

i = 1
Sheets("Server List").Select
Range("A1").Select

servername = ActiveCell.Offset(i, 0).Value

Do Until IsEmpty(servername)

    Sheets("Resolved Met").Select

    With Worksheets("Resolved Met").Range("G:G")
        Set server = .find(What:=servername, LookIn:=xlValues)
        If Not server Is Nothing Then
            firstAddress = server.Address
            Range(firstAddress).Select
            ActiveCell.Offset(0, 13) = servername
            Do
                Set server = .FindNext(server)
                If server Is Nothing Then
                    GoTo DoneFinding2
                End If
                SecondAdress = server.Address
                Range(SecondAdress).Select
                ActiveCell.Offset(0, 13) = servername

            Loop While SecondAdress <> firstAddress
        End If
        DoneFinding2:
    End With


    Sheets("Server List").Select
    i = i + 1
    servername = ActiveCell.Offset(i, 0).Value

Loop
How to&Answers:

You could utilize a Dictionary for this and achieve much better performance

Sub t()

    Dim dict As Object

    Dim i As Long
    Dim endrow As Long

    Set dict = CreateObject("Scripting.Dictionary")

    With Sheets("Server List")
        endrow = .Range("A" & Rows.Count).End(xlUp).Row

        For i = 2 To endrow
            If .Range("A" & i) <> "" Then
                dict.Add CStr(.Range("A" & i)), .Range("A" & i)
            End If
        Next

    End With

    With Sheets("Resolved Met")
        endrow = .Range("G" & Rows.Count).End(xlUp).Row

        For i = 2 To endrow
            If dict.Exists(CStr(.Range("G" & i))) Then
                .Range("G" & i).Offset(0, 13) = dict(CStr(.Range("G" & i)))
            End If
        Next

    End With

End Sub

EDIT:

The code below is based on your comments and the structure of the data you’ve attached. It assumes that, like the dataset provided, servername will be separated from random text by a space. I tested this with an expansion of the dataset provided (expanded to 66K server names in Server List and 130K Lines in Resolved Met) and achieved correct results in 372.672 seconds. A bit lengthy, but it’s about a 98.3% decrease in run-time when compared against the ~6 hours noted in your previous method.

Sub ServerNameLookup()
    Dim dict As Object

    Dim i As Long
    Dim endrow As Long

    Dim textArr
    Dim iText As Long

    Set dict = CreateObject("Scripting.Dictionary")

    With Sheets("Server List")
        endrow = .Range("A" & Rows.Count).End(xlUp).Row

        For i = 2 To endrow
            If .Range("A" & i) <> "" Then
                dict.Add CStr(.Range("A" & i)), .Range("A" & i)
            End If
        Next

    End With

    With Sheets("Resolved Met")
        endrow = .Range("G" & Rows.Count).End(xlUp).Row

        For i = 2 To endrow
            textArr = Split(.Range("G" & i), " ")
            For iText = LBound(textArr) To UBound(textArr)
                If dict.Exists(CStr(textArr(iText))) Then
                    .Range("G" & i).Offset(0, 13) = dict(CStr(textArr(iText)))
                End If
            Next iText
        Next

    End With
End Sub