Web Page to Excel to CSV Automation

B

BGDunbar

Board Regular
Joined
Jul 26, 2016
Messages
79
I am pretty new to writing and troubleshooting Macros. This is going to be long because I have been working on it for a couple months already. I’m now to the point that it needs knowledge I don’t have. I also figure the more info given the better the chance of responses.
My operating system is Windows 7 on one machine and Windows 10 on another. I cannot install addins or software on the Windows 7 machine (work machine).
I have Microsoft Office Plus 2013 on the Windows 7 machine & Open Office 4.12 on the Windows 10 machine. I realize these Macros may not work (probably won’t work) in Open Office.
The bottom line final result I need from this is a CSV file that I can import into an auto-dialer database. If there is a better way to get there I’m all ears.
Issue 1 – Can I automate getting data from webpages into Excel in the proper columns without having to manually copy/paste and run macro to move it? Or better question, Is there a way to get the data from the web page directly into a CSV file?
I have copied and pasted data from 231 web pages onto 231 worksheets within one workbook of Excel 2010. The browser was Mozilla Firefox version 48.0.1. The first web page copied from was Address list for Oregon zip code 97305 | Page 1 of 237 (Page 1 of 231 for one zip code).
The data from each web page consisted of what looked like a table but when copied and pasted the data was pasted in a single column in Excel.
The data elements are Name, Address, & Phone.
There may be multiple names associated with the same, or nearly the same, address or phone.
Not all Names have an associated Phone but pasting like this does not leave a blank row for the phone.
I am manually going thru and inserting lines where needed so the macro I wrote to move the address and phone into columns B & C respectively will work.
Issue 2 – How can I improve the efficiency and length of the existing Macros I’ve created?
The macro I wrote to move the address & phone is very long because I don’t know anything about creating a loop. In addition, it has to be run on each individual worksheet, again because I don’t know how to create a loop.
I have another 20 or so zip codes to pull and process from the above website. Each zip code has multiple pages but the number of pages varies greatly.
Each zip code will have it’s own workbook.
SAMPLE DATA
[TABLE="******* 379"]
<tbody>[TR]
[TD]1. Tasheena Brown
[/TD]
[/TR]
[TR]
[TD]3700 Chemawa Road North East Salem
[/TD]
[/TR]
[TR]
[TD]877-243-6292
[/TD]
[/TR]
[TR]
[TD]2. Roxie Kenendy
[/TD]
[/TR]
[TR]
[TD]3700 Chemawa Road North East Salem
[/TD]
[/TR]
[TR]
[TD]3. Ray Sovalik
[/TD]
[/TR]
[TR]
[TD]3700 Chemawa Road North East Salem
[/TD]
[/TR]
[TR]
[TD]503-798-2055
[/TD]
[/TR]
[TR]
[TD]4. Greg Friesen
[/TD]
[/TR]
[TR]
[TD]3950 Chemawa Road North East Salem
[/TD]
[/TR]
[TR]
[TD]503-585-4407
[/TD]
[/TR]
[TR]
[TD]5. G. Friesen
[/TD]
[/TR]
[TR]
[TD]3950 Chemawa Road North East Salem
[/TD]
[/TR]
[TR]
[TD]503-585-4407
[/TD]
[/TR]
[TR]
[TD]6. Daniel Turner
[/TD]
[/TR]
[TR]
[TD]3700 Chemawa Road North East Salem Salem
[/TD]
[/TR]
[TR]
[TD]307-840-4013
[/TD]
[/TR]
[TR]
[TD]7. Daniel Turner
[/TD]
[/TR]
[TR]
[TD]3700 Chemawa Road North East Salem Salem
[/TD]
[/TR]
[TR]
[TD]307-840-1396
[/TD]
[/TR]
[TR]
[TD]8. Daniel Turner
[/TD]
[/TR]
[TR]
[TD]3700 Chemawa Road North East Salemor Do Salem
[/TD]
[/TR]
[TR]
[TD]307-840-1396
[/TD]
[/TR]
[TR]
[TD]9. Daniel Turner
[/TD]
[/TR]
[TR]
[TD]3700 Chemawa Road NE Salem Salem
[/TD]
[/TR]
[TR]
[TD]307-840-1396
[/TD]
[/TR]
[TR]
[TD]10. Daniel Turner
[/TD]
[/TR]
[TR]
[TD]3700 Chemawa Road NE Salem Salem
[/TD]
[/TR]
[TR]
[TD]307-840-4013
[/TD]
[/TR]
[TR]
[TD]19. Dawn Stone
[/TD]
[/TR]
[TR]
[TD]4406 Cheryl Cresent North East Salem
[/TD]
[/TR]
[TR]
[TD]503-393-3074
[/TD]
[/TR]
</tbody>[/TABLE]

Here is the beginning of the Macro I wrote (hopefully enough to identify where a loop would work)
Code: 
Sub DataMining()
' DataMining Macro
 
' Inserts row abobe data.
 
    Selection.EntireRow.Insert
   
' Adds Column titles "Name", "Address", & "Phone Number".
   
    ActiveCell.FormulaR1C1 = "NAME"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "ADDRESS"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "PHONE"
    Range("D1").Select
   
' Formats column width for Address & Phone Number
 
    Columns("B:B").ColumnWidth = 26.5
    Columns("C:C").ColumnWidth = 26.5
   
' Moves addresses & phones from underneath names to proper column & row
'1
    Range("A3").Select
    Selection.Cut Destination:=Range("B2")
    Range("A4").Select
    Selection.Cut Destination:=Range("C2")
'2
    Range("A6").Select
    Selection.Cut Destination:=Range("B5")
    Range("A7").Select
    Selection.Cut Destination:=Range("C5")
'3
    Range("A9").Select
    Selection.Cut Destination:=Range("B8")
    Range("A10").Select
    Selection.Cut Destination:=Range("C8")
'4
    Range("A12").Select
    Selection.Cut Destination:=Range("B11")
    Range("A13").Select
    Selection.Cut Destination:=Range("C11")
'5
    Range("A15").Select
    Selection.Cut Destination:=Range("B14")
    Range("A16").Select
    Selection.Cut Destination:=Range("C14")
'6
    Range("A18").Select
    Selection.Cut Destination:=Range("B17")
    Range("A19").Select
    Selection.Cut Destination:=Range("C17")
'7
    Range("A21").Select
    Selection.Cut Destination:=Range("B20")
    Range("A22").Select
    Selection.Cut Destination:=Range("C20")

This now repeats through 80 (80 names each page).
I then have additional macros to 1) Remove the blank lines between the resulting lists through sorting by Address; & 2) Remove the numbering in front of the Names.
The Macro to sort by Address and remove the numbers from the Name column could probably use improvement also. It is as follows:
Code: 
Sub Sort()
' Sort Macro
'
    Range("A1").Select
    Range("A1:C239").Select
    With ActiveWorkbook.Worksheets("Sheet26").Sort
        .SetRange Range("A2:C239")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("A:A").Select
    Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="1", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="2", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="3", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="4", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="5", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="6", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="7", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="8", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="9", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=". ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A1:C81").Select
    With ActiveWorkbook.Worksheets("Sheet26").Sort
        .SetRange Range("A1:C81")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Sort by date Sort by votes
Heres an example of a loop for the first macro. It assumes the sample data starts in A2.

Code: 
Set sh = Sheets("Sheet1")
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
With sh
    For i = 2 To lr Step 3
        .Range("A" & i + 1).Cut Destination:=.Range("B" & i)
        .Range("A" & i + 2).Cut Destination:=.Range("C" & i)
    Next
End With
 
Upvote 0
Thank you steve the fish.
I have 263 sheets in one workbook that all need this macro. Does the first line of the code set the sheet to only sheet1?
 
Upvote 0
The code works if I change the "Sheet1" designation for each worksheet. Is there a way to loop through all the worksheets in a workbook?
 
Upvote 0
In trying to combine the loop Steve gave me with a loop for all worksheets I get a compile error that I have a "Next" without a "For".

Here is the modified code
Code: 
Sub DataMove()

' Moves addresses & phones from underneath names to proper column & row
'
    Dim WkSht As Worksheet
    For Each WkSht In ActiveWorkbook.Worksheets
    
        lr = WkSht.Range("A" & Rows.Count).End(xlUp).Row
    With WkSht
        For i = 2 To lr Step 3
            .Range("A" & i + 1).Cut Destination:=.Range("B" & i)
            .Range("A" & i + 2).Cut Destination:=.Range("C" & i)
        Next
    Next
        
End With


End Sub

What am I doing wrong?
 
Upvote 0
The order that things close needs to the the reverse order of how they open.
So you have:
Code: 
    For ...
       With ...
           For ...
So the closure needs to look like:
Code: 
           Next...
       End With ...
    Next ...
So you have the last two flip-flopped.
 
Upvote 0
Now I'm getting an error:
"Run-time error '1004':
We can't make this change for the selected cells because it will affect a PivotTable. Use the field list to change the report. If you are trying to insert or delete cells, move the PivotTable and try again."

I do not have and never have had a PivotTable in this workbook.
 
Upvote 0
Code: 
Sub DataMove()

' Moves addresses & phones from underneath names to proper column & row
'
    Dim WkSht As Worksheet
    For Each WkSht In ActiveWorkbook.Worksheets
    
        lr = WkSht.Range("A" & Rows.Count).End(xlUp).Row
    With WkSht
        For i = 2 To lr Step 3
            .Range("A" & i + 1).Cut Destination:=.Range("B" & i)
            .Range("A" & i + 2).Cut Destination:=.Range("C" & i)
        Next
           
End With
        Next

End Sub
 
Upvote 0
Now I'm getting an error:
"Run-time error '1004':
We can't make this change for the selected cells because it will affect a PivotTable. Use the field list to change the report. If you are trying to insert or delete cells, move the PivotTable and try again."

I do not have and never have had a PivotTable in this workbook.
Click to expand...
I am guessing it has something to do with how the data is being copied from the Webpage to Excel.
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
How to loop to find and replace with the specific cells
Replies
2
Views
297
Linda Lo
L
N
  • Question Question
Not understanding loop in vba
Replies
7
Views
296
jolivanes
jolivanes
J
  • Solved
Assistance with excel macro
Replies
3
Views
244
dreid1011
dreid1011
D
  • Solved
Range selection specific column with End(xlDown)
Replies
8
Views
296
dwalc
D
L
  • Locked
  • Question Question
Macros and protecting a cell
Replies
5
Views
82
Fluff
Fluff

Forum statistics

Threads
1,223,270
Messages
6,171,102
Members
452,379
Latest member
IainTru

Share this page

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
Back
Top