Need a bit of help updating my code

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,047
Office Version
  1. 2016
Platform
  1. Windows
I have a code which pulls off the social media url link to a site if it has a social media on the site. I need a bit of help to update this code and I can not work it out.

Currently
It starts from rows 2 in the ACTIVE SHEET and places the data into the the ACTIVE SHEET.

What I need

I need it to get the url list from Sheet3 and place the data into Sheet3 columns as stated in the code. It should not matter what sheet I am on, the urls are lisited in sheet3 and the data should also go into that sheet.

VBA Code:
Command Button1_Click ()
Dim counter As Long
Dim website As Range
Dim row As Long
Dim continue As Boolean
Dim respHead As String
    
''''The row where website addresses start
row = 2
    continue = True
    
Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    Do While continue
'''Could set this to first cell with URL then OFFSET columns to get next web site
'    Set website = Range("A" & row)
Set website = Range("A" & row)
        If Len(website.Value) < 1 Then
            continue = False
        Exit Sub
        End If
        
        If website Is Nothing Then
            continue = False
        End If
'''Debug.Print website
    With http
        On Error Resume Next
        .Open "GET", website.Value, False
        .send
'''If the website sent a valid response to our request, URLS ARE IN COLUMN A
    If Err.Number = 0 Then
        If .Status = 200 Then
            HTML.body.innerHTML = http.responseText
                Set links = HTML.getElementsByTagName("a")
'''COLUMN C = FACEBOOK
    For Each link In links
      If InStr(UCase(link.outerHTML), "FACEBOOK") Then
      Website.Offset(0, 2).Value = link.href
      End If
'''COLUMN D = TWITTER
    If InStr(UCase(link.outerHTML), "INSTAGRAM") Then
        Sheet3.Cells.website.Offset(0, 3).Value = link.href
    End If

Next
    End If
    Set website = Nothing
Else
'''Debug.Print "Error loading page IN COLUMN H"
    website.Offset(0, 8).Value = "Error with website address"
    End If
On Error GoTo 0
    End With
row = row + 1
    Loop

End Sub
 

Some videos you may like

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
Amend the following line
Set website = .Range("A" & row)
VBA Code:
    Set website = Thisworkbook.Worksheets("Sheet3").Range("A" & row)
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,126,928
Messages
5,621,638
Members
415,849
Latest member
PhoenixRising2015

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top