Option Explicit

Public strExtracted1 As String, strExtracted2 As String, strExtracted3 As String, strExtracted4 As String, strExtracted5 As String, strBody As String
Public arrBody
Public FollowingFound As String, FollowersFound As String, PostsFound As String, BioFound As String

Sub OpenIG()

'set objects

    Dim arrUsers
    Dim strUser As String
    Dim rngArray As Range, UsedRange As Range, c As Range, rngUsers As Range, rngRange As Range
    Dim p As Integer, x As Integer, q As Integer, i As Integer, intLR As Integer, g As Integer, k As Integer, h As Integer

    Dim DOC As MSHTML.HTMLDocument
    Dim IE As SHDocVw.InternetExplorer

  On Error GoTo ErrHandler

p = 3

With ActiveSheet

        intLR = .Range("B2").CurrentRegion.Rows.Count

        Set rngUsers = .Range("B3:B" & intLR + 2)

        arrUsers = rngUsers

End With


For x = 1 To UBound(arrUsers) - 1

    ActiveSheet.Range("C2").Value = "Processing " & x & "/" & UBound(arrUsers) - 1

FollowingFound = ""
FollowersFound = ""
PostsFound = ""
BioFound = ""



RetryUser:

    strBody = ""

        strUser = arrUsers(x, 1)

        strUser = Trim(strUser)

    Set IE = New SHDocVw.InternetExplorer

    With IE

        strUser = arrUsers(x, 1)
        strUser = Trim(strUser)

        .navigate "https://www.instagram.com/" & strUser
        .Visible = False

        Application.Wait (Now + TimeValue("00:00:02"))

        Do While .Busy Or .readyState <> 4: DoEvents: Loop

        Set DOC = .document

        strBody = DOC.body.innerText

    End With



        IE.Quit

        Set IE = Nothing

        arrBody = Split(strBody, Chr(10))

        If UBound(arrBody) < 3 Then
            Application.Wait (Now + TimeValue("00:00:01"))
            GoTo RetryUser
        End If

        For g = 1 To UBound(arrBody)

            If InStr(arrBody(g), "Sorry, this page isn't available") > 0 Then

                strExtracted2 = "0"
                PostsFound = "0"
                FollowersFound = "0"
                FollowingFound = "0"

                GoTo InsertBlankData

            End If

        Next g

        q = UBound(arrBody)

    With ActiveSheet

'        Set UsedRange = ActiveSheet.Range("Z1:Z" & q)
'
'        UsedRange = arrBody
'
'        Set UsedRange = ActiveSheet.Range("Z1:Z" & q)'

        h = 1
        k = 0
        Set rngRange = Range("Z1")
'        Set UsedRange = UsedRange.Resize(UBound(arrBody))
'        UsedRange.Value = Application.Transpose(arrBody)
'
'
'        Application.ScreenUpdating = False
'        Application.Calculation = xlCalculationManual

        For h = 1 To UBound(arrBody)

            Range("Z" & h) = arrBody(k)
            k = k + 1


        Next h

        Set rngRange = Range("Z1:Z" & h)


        Dim s As String
        For Each c In rngRange

            s = c.Value
            If Trim(Application.Clean(s)) <> s Then
            s = Trim(Application.Clean(s))
            c.Value = s
            End If

        Next

        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic

        arrBody = rngRange

        ActiveSheet.Range("Z1:Z" & h).ClearContents

    End With

        For i = 1 To UBound(arrBody)

            If Trim(UCase(arrBody(i, 1))) = UCase(strUser) Then

                Call FindPositions(i)

                Call LocateData(i)

                Exit For
            End If

        Next i

InsertBlankData:

    With ActiveSheet

        .Range("E" & p).Value = BioFound
        .Range("F" & p).Value = ExtractNums(PostsFound)
        .Range("G" & p).Value = ExtractNums(FollowersFound)
        .Range("H" & p).Value = ExtractNums(FollowingFound)

        p = p + 1

    End With


Next x


ErrHandler:

If Not IE Is Nothing Then
    IE.Quit
    Set IE = Nothing
GoTo RetryUser
End If

End Sub

Function ExtractNums(str As String) As String
    Dim strVal As String
    Dim i As Integer

'        If InStr(1, str, ".") > 0 Then
'
'            str = str & "00000"
'
'            GoTo Found
'
'        End If

        If InStr(1, str, ".") > 0 And InStr(1, str, "k") > 0 Then

            str = str & "00"

            GoTo Found

        End If


        If InStr(1, str, "k") > 0 Then

            str = str & "000"

            GoTo Found

        End If

         If InStr(1, str, ".") > 0 And InStr(1, str, "m") > 0 Then

            str = str & "00000"

            GoTo Found

        End If


        If InStr(1, str, "m") <> 0 Then


        str = str & "000000"

            GoTo Found

        End If

Found:
    strVal = ""
                                   '
    For i = 1 To Len(str)
        If Mid(str, i, 1) >= "0" And Mid(str, i, 1) <= "9" Then
            strVal = strVal + Mid(str, i, 1)
        End If
    Next


    ExtractNums = strVal
End Function

Sub LocateData(loc As Integer)

Dim b As Integer

For b = loc To UBound(arrBody, 1)

    If InStr(arrBody(b, 1), "post") > 0 Then

        PostsFound = arrBody(b, 1)
    Exit For
    End If

Next b

For b = loc To UBound(arrBody, 1)

    If InStr(arrBody(b, 1), "followers") > 0 Or InStr(arrBody(b, 1), "follower") Then

        FollowersFound = arrBody(b, 1)
    Exit For
        End If
Next b

For b = loc To UBound(arrBody, 1)

    If InStr(arrBody(b, 1), "following") > 0 Then

        FollowingFound = arrBody(b, 1)

    Exit For
        End If
Next b

End Sub


Sub FindPositions(loc As Integer)

Dim b As Integer
Dim FoundPostsposition As Integer, FoundFollowersPosition As Integer, FoundFollowingPosition As Integer, LastPosition As Integer
Dim MaxValue As Integer
Dim BioPosition As Integer, k As Integer

For b = loc To UBound(arrBody, 1)

    If InStr(arrBody(b, 1), "post") > 0 Then

        FoundPostsposition = b
    Exit For
    End If

Next b


For b = loc To UBound(arrBody, 1)

    If InStr(arrBody(b, 1), "followers") > 0 Or InStr(arrBody(b, 1), "follower") > 0 Then

        FoundFollowersPosition = b
    Exit For
        End If
Next b

For b = loc To UBound(arrBody, 1)

    If InStr(arrBody(b, 1), "following") > 0 Then

        FoundFollowingPosition = b

    Exit For
    End If

Next b


For b = loc To UBound(arrBody, 1)

    If Len(arrBody(b, 1)) > 0 Then

        LastPosition = b


    End If

Next b


MaxValue = Application.Max(FoundPostsposition, FoundFollowingPosition, FoundFollowersPosition, LastPosition)

For b = loc + 1 To MaxValue

    If arrBody(b, 1) <> "No posts yet." And arrBody(b, 1) <> "" And arrBody(b, 1) <> "Follow" And arrBody(b, 1) <> "Verified" And b <> FoundPostsposition And b <> FoundFollowingPosition And b <> FoundFollowersPosition Then

        BioPosition = b
        BioFound = arrBody(b, 1)

    Exit For
    End If

Next b

End Sub