I currently have an Excel workbook which pulls data from a website that lists sign language interpreters from here.
There are 7 different regions, or tables, I pull from. The data is put into Sheet1, Columns A, C, E, G, I, K, M - all starting in row 1. The VBA I have written then sorts/splits this data into Sheet2 using 8 buttons above the data - also located on Sheet2 using 8 buttons above the data - also located on Sheet2.
It allows me to sort between displaying all the data, or by region. The code I use works really well but, it seems overly complicated and... well, not that good. I feel like this isn't the most streamlined way, but it's what I currently know and can make function. What I really want to know is, Is there a better or simpler way? As one commenter told me, ,
Don't write code that "works", write code your successor won't want to stab you for writing.
-@Mat's-Mug
I agree.
Please help me with any gross errors regarding best practices, coding is not my profession, however, please correct me if you see something I should not be doing. I am looking for guidance and picking things up as I go. Thanks!
TL;DR
I assign each button a macro which then calls a Sub that copies and splits the data from Sheet1 and displays it on Sheet2.
Public s1 As Worksheet
Public s2 As Worksheet
Public aRegions As Long
Public cCounty As Long
Public nEast As Long
Public nWest As Long
Public wCentral As Long
Public eCentral As Long
Public rSouth As Long
Public oState As Long
Public i As Long
Public K As Long
Public vConstants As Range
Public xConstants As Range
Public v As String
Sub AllRegions()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set vConstants = s2.Range("A10:Z99999").SpecialCells(xlCellTypeConstants)
Set xConstants = s2.Range("H10:N10")
K = 10
vConstants.ClearContents
CookCounty
NortheastRegion
NorthwestRegion
WestCentralReg
EastCentralReg
SouthernRegion
OtherState
xConstants.Delete xlUp
End Sub
Sub ButtonOne()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set vConstants = s2.Range("A10:Z99999").SpecialCells(xlCellTypeConstants)
Set xConstants = s2.Range("H10:N10")
K = 10
vConstants.ClearContents
Call CookCounty
xConstants.Delete xlUp
End Sub
Sub ButtonTwo()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set vConstants = s2.Range("A10:Z99999").SpecialCells(xlCellTypeConstants)
Set xConstants = s2.Range("H10:N10")
K = 10
vConstants.ClearContents
Call NortheastRegion
xConstants.Delete xlUp
End Sub
Sub ButtonThree()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set vConstants = s2.Range("A10:Z99999").SpecialCells(xlCellTypeConstants)
Set xConstants = s2.Range("H10:N10")
K = 10
vConstants.ClearContents
Call NorthwestRegion
xConstants.Delete xlUp
End Sub
Sub ButtonFour()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set vConstants = s2.Range("A10:Z99999").SpecialCells(xlCellTypeConstants)
Set xConstants = s2.Range("H10:N10")
K = 10
vConstants.ClearContents
Call WestCentralReg
xConstants.Delete xlUp
End Sub
Sub ButtonFive()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set vConstants = s2.Range("A10:Z99999").SpecialCells(xlCellTypeConstants)
Set xConstants = s2.Range("H10:N10")
K = 10
vConstants.ClearContents
Call EastCentralReg
xConstants.Delete xlUp
End Sub
Sub ButtonSix()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set vConstants = s2.Range("A10:Z99999").SpecialCells(xlCellTypeConstants)
Set xConstants = s2.Range("H10:N10")
K = 10
vConstants.ClearContents
Call SouthernRegion
xConstants.Delete xlUp
End Sub
Sub ButtonSeven()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set vConstants = s2.Range("A10:Z99999").SpecialCells(xlCellTypeConstants)
Set xConstants = s2.Range("H10:N10")
K = 10
vConstants.ClearContents
Call OtherState
xConstants.Delete xlUp
End Sub
Sub CookCounty()
On Error Resume Next
cCounty = s1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To cCounty
v = s1.Cells(i, "A").Text
If v = "Contact Information" Then
K = K + 1
Else
If v Like "Name:*" Then
s2.Cells(K, 1) = Split(Split(v, ", ")(1), " ")(0) 'First Name
s2.Cells(K, 2) = Split(Split(v, ": ")(1), ",")(0) 'Last Name
End If
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, "- ")(1)
If v Like "License: General - *" Then
s2.Cells(K, 3) = Split(v, "- ")(1)
Else
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, ": ")(1)
End If
If v Like "License Status:*" Then s2.Cells(K, 4) = Split(v, ": ")(1)
If v Like "City/State:*" Then s2.Cells(K, 5) = Split(Split(v, ": ")(1), ",")(0)
If v Like "City/State:*" Then s2.Cells(K, 6) = Split(Split(v, ": ")(1), ", ")(1)
If v Like "County:*" Then s2.Cells(K, 7) = Split(v, ": ")(1)
If v Like "Home Phone:*" Then s2.Cells(K, 8) = Split(v, ": ")(1)
If v Like "Work Phone:*" Then s2.Cells(K, 9) = Split(v, ": ")(1)
If v Like "Cell Phone:*" Then s2.Cells(K, 10) = Split(v, ": ")(1)
If v Like "Email Address:*" Then s2.Cells(K, 11) = Split(v, ": ")(1)
If v Like "Region:*" Then s2.Cells(K, 12) = Split(v, ": ")(1)
If v Like "Ever Been Disciplined?:*" Then s2.Cells(K, 13) = Split(v, ": ")(1)
End If
Next i
End Sub
Sub NortheastRegion()
On Error Resume Next
nEast = s1.Cells(Rows.Count, "C").End(xlUp).Row
For i = 1 To nEast
v = s1.Cells(i, "C").Text
If v = "Contact Information" Then
K = K + 1
Else
If v Like "Name:*" Then
s2.Cells(K, 1) = Split(Split(v, ", ")(1), " ")(0) 'First Name
s2.Cells(K, 2) = Split(Split(v, ": ")(1), ",")(0) 'Last Name
End If
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, "- ")(1)
If v Like "License: General - *" Then
s2.Cells(K, 3) = Split(v, "- ")(1)
Else
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, ": ")(1)
End If
If v Like "License Status:*" Then s2.Cells(K, 4) = Split(v, ": ")(1)
If v Like "City/State:*" Then s2.Cells(K, 5) = Split(Split(v, ": ")(1), ",")(0)
If v Like "City/State:*" Then s2.Cells(K, 6) = Split(Split(v, ": ")(1), ", ")(1)
If v Like "County:*" Then s2.Cells(K, 7) = Split(v, ": ")(1)
If v Like "Home Phone:*" Then s2.Cells(K, 8) = Split(v, ": ")(1)
If v Like "Work Phone:*" Then s2.Cells(K, 9) = Split(v, ": ")(1)
If v Like "Cell Phone:*" Then s2.Cells(K, 10) = Split(v, ": ")(1)
If v Like "Email Address:*" Then s2.Cells(K, 11) = Split(v, ": ")(1)
If v Like "Region:*" Then s2.Cells(K, 12) = Split(v, ": ")(1)
If v Like "Ever Been Disciplined?:*" Then s2.Cells(K, 13) = Split(v, ": ")(1)
End If
Next i
End Sub
Sub NorthwestRegion()
On Error Resume Next
nWest = s1.Cells(Rows.Count, "E").End(xlUp).Row
For i = 1 To nWest
v = s1.Cells(i, "E").Text
If v = "Contact Information" Then
K = K + 1
Else
If v Like "Name:*" Then
s2.Cells(K, 1) = Split(Split(v, ", ")(1), " ")(0) 'First Name
s2.Cells(K, 2) = Split(Split(v, ": ")(1), ",")(0) 'Last Name
End If
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, "- ")(1)
If v Like "License: General - *" Then
s2.Cells(K, 3) = Split(v, "- ")(1)
Else
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, ": ")(1)
End If
If v Like "License Status:*" Then s2.Cells(K, 4) = Split(v, ": ")(1)
If v Like "City/State:*" Then s2.Cells(K, 5) = Split(Split(v, ": ")(1), ",")(0)
If v Like "City/State:*" Then s2.Cells(K, 6) = Split(Split(v, ": ")(1), ", ")(1)
If v Like "County:*" Then s2.Cells(K, 7) = Split(v, ": ")(1)
If v Like "Home Phone:*" Then s2.Cells(K, 8) = Split(v, ": ")(1)
If v Like "Work Phone:*" Then s2.Cells(K, 9) = Split(v, ": ")(1)
If v Like "Cell Phone:*" Then s2.Cells(K, 10) = Split(v, ": ")(1)
If v Like "Email Address:*" Then s2.Cells(K, 11) = Split(v, ": ")(1)
If v Like "Region:*" Then s2.Cells(K, 12) = Split(v, ": ")(1)
If v Like "Ever Been Disciplined?:*" Then s2.Cells(K, 13) = Split(v, ": ")(1)
End If
Next i
End Sub
Sub WestCentralReg()
On Error Resume Next
wCentral = s1.Cells(Rows.Count, "G").End(xlUp).Row
For i = 1 To wCentral
v = s1.Cells(i, "G").Text
If v = "Contact Information" Then
K = K + 1
Else
If v Like "Name:*" Then
s2.Cells(K, 1) = Split(Split(v, ", ")(1), " ")(0) 'First Name
s2.Cells(K, 2) = Split(Split(v, ": ")(1), ",")(0) 'Last Name
End If
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, "- ")(1)
If v Like "License: General - *" Then
s2.Cells(K, 3) = Split(v, "- ")(1)
Else
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, ": ")(1)
End If
If v Like "License Status:*" Then s2.Cells(K, 4) = Split(v, ": ")(1)
If v Like "City/State:*" Then s2.Cells(K, 5) = Split(Split(v, ": ")(1), ",")(0)
If v Like "City/State:*" Then s2.Cells(K, 6) = Split(Split(v, ": ")(1), ", ")(1)
If v Like "County:*" Then s2.Cells(K, 7) = Split(v, ": ")(1)
If v Like "Home Phone:*" Then s2.Cells(K, 8) = Split(v, ": ")(1)
If v Like "Work Phone:*" Then s2.Cells(K, 9) = Split(v, ": ")(1)
If v Like "Cell Phone:*" Then s2.Cells(K, 10) = Split(v, ": ")(1)
If v Like "Email Address:*" Then s2.Cells(K, 11) = Split(v, ": ")(1)
If v Like "Region:*" Then s2.Cells(K, 12) = Split(v, ": ")(1)
If v Like "Ever Been Disciplined?:*" Then s2.Cells(K, 13) = Split(v, ": ")(1)
End If
Next i
End Sub
Sub EastCentralReg()
On Error Resume Next
eCentral = s1.Cells(Rows.Count, "I").End(xlUp).Row
For i = 1 To eCentral
v = s1.Cells(i, "I").Text
If v = "Contact Information" Then
K = K + 1
Else
If v Like "Name:*" Then
s2.Cells(K, 1) = Split(Split(v, ", ")(1), " ")(0) 'First Name
s2.Cells(K, 2) = Split(Split(v, ": ")(1), ",")(0) 'Last Name
End If
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, "- ")(1)
If v Like "License: General - *" Then
s2.Cells(K, 3) = Split(v, "- ")(1)
Else
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, ": ")(1)
End If
If v Like "License Status:*" Then s2.Cells(K, 4) = Split(v, ": ")(1)
If v Like "City/State:*" Then s2.Cells(K, 5) = Split(Split(v, ": ")(1), ",")(0)
If v Like "City/State:*" Then s2.Cells(K, 6) = Split(Split(v, ": ")(1), ", ")(1)
If v Like "County:*" Then s2.Cells(K, 7) = Split(v, ": ")(1)
If v Like "Home Phone:*" Then s2.Cells(K, 8) = Split(v, ": ")(1)
If v Like "Work Phone:*" Then s2.Cells(K, 9) = Split(v, ": ")(1)
If v Like "Cell Phone:*" Then s2.Cells(K, 10) = Split(v, ": ")(1)
If v Like "Email Address:*" Then s2.Cells(K, 11) = Split(v, ": ")(1)
If v Like "Region:*" Then s2.Cells(K, 12) = Split(v, ": ")(1)
If v Like "Ever Been Disciplined?:*" Then s2.Cells(K, 13) = Split(v, ": ")(1)
End If
Next i
End Sub
Sub SouthernRegion()
On Error Resume Next
rSouth = s1.Cells(Rows.Count, "K").End(xlUp).Row
For i = 1 To rSouth
v = s1.Cells(i, "K").Text
If v = "Contact Information" Then
K = K + 1
Else
If v Like "Name:*" Then
s2.Cells(K, 1) = Split(Split(v, ", ")(1), " ")(0) 'First Name
s2.Cells(K, 2) = Split(Split(v, ": ")(1), ",")(0) 'Last Name
End If
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, "- ")(1)
If v Like "License: General - *" Then
s2.Cells(K, 3) = Split(v, "- ")(1)
Else
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, ": ")(1)
End If
If v Like "License Status:*" Then s2.Cells(K, 4) = Split(v, ": ")(1)
If v Like "City/State:*" Then s2.Cells(K, 5) = Split(Split(v, ": ")(1), ",")(0)
If v Like "City/State:*" Then s2.Cells(K, 6) = Split(Split(v, ": ")(1), ", ")(1)
If v Like "County:*" Then s2.Cells(K, 7) = Split(v, ": ")(1)
If v Like "Home Phone:*" Then s2.Cells(K, 8) = Split(v, ": ")(1)
If v Like "Work Phone:*" Then s2.Cells(K, 9) = Split(v, ": ")(1)
If v Like "Cell Phone:*" Then s2.Cells(K, 10) = Split(v, ": ")(1)
If v Like "Email Address:*" Then s2.Cells(K, 11) = Split(v, ": ")(1)
If v Like "Region:*" Then s2.Cells(K, 12) = Split(v, ": ")(1)
If v Like "Ever Been Disciplined?:*" Then s2.Cells(K, 13) = Split(v, ": ")(1)
End If
Next i
End Sub
Sub OtherState()
On Error Resume Next
oState = s1.Cells(Rows.Count, "M").End(xlUp).Row
For i = 1 To oState
v = s1.Cells(i, "M").Text
If v = "Contact Information" Then
K = K + 1
Else
If v Like "Name:*" Then
s2.Cells(K, 1) = Split(Split(v, ", ")(1), " ")(0) 'First Name
s2.Cells(K, 2) = Split(Split(v, ": ")(1), ",")(0) 'Last Name
End If
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, "- ")(1)
If v Like "License: General - *" Then
s2.Cells(K, 3) = Split(v, "- ")(1)
Else
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, ": ")(1)
End If
If v Like "License Status:*" Then s2.Cells(K, 4) = Split(v, ": ")(1)
If v Like "City/State:*" Then s2.Cells(K, 5) = Split(Split(v, ": ")(1), ",")(0)
If v Like "City/State:*" Then s2.Cells(K, 6) = Split(Split(v, ": ")(1), ", ")(1)
If v Like "County:*" Then s2.Cells(K, 7) = Split(v, ": ")(1)
If v Like "Home Phone:*" Then s2.Cells(K, 8) = Split(v, ": ")(1)
If v Like "Work Phone:*" Then s2.Cells(K, 9) = Split(v, ": ")(1)
If v Like "Cell Phone:*" Then s2.Cells(K, 10) = Split(v, ": ")(1)
If v Like "Email Address:*" Then s2.Cells(K, 11) = Split(v, ": ")(1)
If v Like "Region:*" Then s2.Cells(K, 12) = Split(v, ": ")(1)
If v Like "Ever Been Disciplined?:*" Then s2.Cells(K, 13) = Split(v, ": ")(1)
End If
Next i
End Sub
3 Answers 3
A better solution would be to modify build a Web Scraper to parse the records.
The other answers all bring up valid points. I would add that you should replace all the If Statements with a Select Case Statement (see: Sub AppendRecord
for an example).
Option Explicit
Sub Main()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Const Regions_URL = "https://www.illinois.gov/idhhc/licensure/Pages/Regions.aspx"
Dim doc As MSHTML.HTMLDocument, div As HTMLDivElement, a As HTMLAnchorElement
Set doc = getDocument(Regions_URL)
ClearRecords
Set div = doc.getElementById("wpzRight")
For Each a In div.getElementsByTagName("A")
ProcessRegion Replace(a.href, "about:", "https://www.illinois.gov")
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub ClearRecords()
Worksheets("Records").UsedRange.Offset(1).ClearContents
End Sub
Private Sub ProcessRegion(URL As String)
Dim doc As MSHTML.HTMLDocument, tbl As HTMLTable, tr As HTMLTableRow
Set doc = getDocument(URL)
If Not doc Is Nothing Then
For Each tbl In doc.getElementsByClassName("soi-table table")
For Each tr In tbl.getElementsByTagName("TR")
AppendRecord tr.innerText
Next
Next
End If
End Sub
Private Sub AppendRecord(RecordText As String)
Dim Name As String, License As String, License_Status As String, City_State As String, County As String, Cell_Phone As String, Email_Address As String, Region As String, Disciplined As String
Dim Target As Range
Dim arrLines As Variant
Dim x As Long
arrLines = Split(RecordText, vbCrLf)
For x = 0 To UBound(arrLines)
If InStr(arrLines(x), ":") Then
Select Case Split(arrLines(x), ":")(0)
Case "Name"
Name = Split(arrLines(x), ":")(1)
Case "License"
License = Split(arrLines(x), ":")(1)
Case "License Status"
License_Status = Split(arrLines(x), ":")(1)
Case "City/State"
City_State = Split(arrLines(x), ":")(1)
Case "County"
County = Split(arrLines(x), ":")(1)
Case "Cell Phone"
Cell_Phone = Split(arrLines(x), ":")(1)
Case "Email Address"
Email_Address = Split(arrLines(x), ":")(1)
Case "Region"
Region = Split(arrLines(x), ":")(1)
Case "Ever Been Disciplined?"
Disciplined = Split(arrLines(x), ":")(1)
End Select
End If
Next
With Worksheets("Records")
Set Target = .Range("A" & .Rows.Count).End(xlUp).Offset(1)
Target.Resize(1, 9).Value = Array(Region, Name, License, License_Status, City_State, County, Cell_Phone, Email_Address, Disciplined)
End With
End Sub
Public Function getDocument(URL As String) As MSHTML.HTMLDocument
Dim doc As MSHTML.HTMLDocument
With New MSXML2.XMLHTTP60
.Open "GET", URL, False
.send
If .readyState = 4 And .Status = 200 Then
Set doc = New MSHTML.HTMLDocument
doc.body.innerHTML = .responseText
Set getDocument = doc
Else
MsgBox "URL: " & vbCrLf & "Ready state: " & .readyState & vbCrLf & "HTTP request status: " & .Status, vbInformation, "URL Not Responding"
End If
End With
End Function
Required References:
- Microsoft HTML Object Libary
- Microsoft XML. v#.#
-
\$\begingroup\$ This works rather well for pulling the data, thank you. I would like to ask, what is the benefit of using Select Case Statements in place of If Statements? \$\endgroup\$C.Nug– C.Nug2017年11月09日 16:21:35 +00:00Commented Nov 9, 2017 at 16:21
-
1\$\begingroup\$ @C.Nug There is a insignificant performance benefit compared to the way that you used your if statements. Ideally, you should have used
ElseIf
statements becauseIf v Like "License Status:*" Then
one occurs there is no reason to testIf v Like "City/State:*" Then
. I recommended theSelect Case
statement to improve readability. \$\endgroup\$user109261– user1092612017年11月09日 16:34:18 +00:00Commented Nov 9, 2017 at 16:34 -
\$\begingroup\$ I hope this is correct, would this change I made to the License Select Case Statement be correct? The code works, but that doesn't mean it is correct:
Case "License" If InStr(arrLines(x), ": General -") Then License = Split(arrLines(x), "- ")(1) Else License = Split(arrLines(x), ": ")(1) End If
Again, this works to separate the License field from listing"General - Master"
to just"Master"
and the licenses which are not preceded by the word"General"
will now also display correctly. Also, how do I add a carriage return in these comments??? \$\endgroup\$C.Nug– C.Nug2017年11月14日 22:17:01 +00:00Commented Nov 14, 2017 at 22:17 -
1\$\begingroup\$ @C.Nug That is the way I would do it. \$\endgroup\$user109261– user1092612017年11月14日 23:12:45 +00:00Commented Nov 14, 2017 at 23:12
It looks like you've already done this - Tools>Options>Require Variable Declaration
- which makes sure you Dim
your variables. If not do so, now, future-you will thank you.
You are using s1
and s2
and are only setting them to Sheets("Sheet1")
and Sheets("Sheet2")
respectively. This will break if you change the Name
of the worksheet. You can get the same effect by using the worksheet CodeName
property. You can see it in the Project Explorer
window View>Project Explorer
Ctrl+R for the shortcut. Likely you'll see Sheet1 (Sheet1)
. The CodeName
is on the left and the Name
is what's displayed inside of ()
. Using CodeName
will make your code less prone to breaking.
There is a lot of copy/pasting that was done. This makes it difficult to fix issues if you find there's a problem/bug with your code. You have to go back and make sure you get every single spot it was copied to. The better option is to follow DRY (Don't Repeat Yourself). Where possible encapsulate your logic into a Sub
or Function
that does one thing, based on what you feed into it.
CookCounty
, NortheastRegion
, NorthwestRegion
and all the rest are doing the same thing. The part that's different is the column that's being used for the row count. To make your code more generic replace nEast
with lastRow
.
Old code:
nEast = s1.Cells(Rows.Count, "C").End(xlUp).Row
More Generic:
lastRow = Sheet1.Cells(Rows.Count,"C").End(xlUp).Row
.
There is still the C
that's tying you to a specific column. You can remedy this by supplying an argument that represents column you want to use when you call the function. PopulateGeographicArea(ByVal usedColumn as long)
Even more generic:
lastRow = Sheet1.Cells(Rows.Count, usedColumn).End(xlUp).Row
This takes what was 8 different methods and condenses them into 1 that you supply which column to use. Instead of NortheastRegion
you'll have PopulateGeographicArea(3)
.
This clears a lot of your public variables declared at the top. Do you want to remember that Cook County corresponds to Column 1, Northeast=3, Nothwest=5... Nope. Use an Enum
(Enumeration) that will allow words to represent numbers. The Enum
will start off at 0 if not specified and increment by 1 for each value that follows. Unknown
is included to help prevent false positives from accepting a valid default.
Private Enum GeographicArea
Unknown = 0
Cook = 1
Northeast = 3
...
End Enum
Previously you had to remember what the numbers were representing. Now change the method signature to be PopulateGeographicArea(ByVal geoArea as GeographicArea)
. This makes your code self documenting, it should tell you what it is doing.
Had to remember: PopulateGeographicArea(3)
Immediately known: PopulateGeographicArea(Cook)
You have a lot of If v Like "Name:*" Then
checks that are doing something. What is it doing? Incrementing a number or populating info. Create a Sub
for each part and then supply to it the parameters it needs to do its job.
If v Like "Name:*" Then
s2.Cells(K, 1) = Split(Split(v, ", ")(1), " ")(0) 'First Name
s2.Cells(K, 2) = Split(Split(v, ": ")(1), ",")(0) 'Last Name
End If
becomes
Private Sub PopulateName(ByVal ws As Worksheet, ByVal content As String, ByVal checkRow As Long)
ws.Cells(checkRow, 1) = Split(Split(content, ", ")(1), " ")(0) 'FirstName
ws.Cells(checkRow, 2) = Split(Split(content, ": ")(1), ",")(0) 'LastName
End Sub
Do the same to the entire block of If v Like "Name:*" Then ...
checks and encapsulate them all into their own. This ends up with Private Sub PopulateInformation(ByVal populateSheet As Worksheet, ByVal content As String, ByVal checkRow As Long)
.
Once done you end up with each piece self documenting what it's doing. Using good names for variables and methods (Sub
and Function
) that describe what they are doing help a lot.
Option Explicit
Private Enum GeographicArea
Unknown = 0
Cook = 1
Northeast = 3 'without explicit numbering step of 1 for each entry
Nothwest = 5
WestCentral = 7
EastCentral = 9
Southern = 11
OutOfState = 13
End Enum
Sub PopulateAllOfIllinois()
PopulateGeographicArea Sheet1, Sheet2, Cook
PopulateGeographicArea Sheet1, Sheet2, Northeast
PopulateGeographicArea Sheet1, Sheet2, Nothwest
PopulateGeographicArea Sheet1, Sheet2, WestCentral
PopulateGeographicArea Sheet1, Sheet2, EastCentral
PopulateGeographicArea Sheet1, Sheet2, Southern
PopulateGeographicArea Sheet1, Sheet2, OutOfState
DeleteRangeAndShiftUp
End Sub
Sub ButtonOne()
PopulateGeographicArea Sheet1, Sheet2, Cook
DeleteRangeAndShiftUp
End Sub
Sub ButtonTwo()
PopulateGeographicArea Sheet1, Sheet2, Northeast
DeleteRangeAndShiftUp
End Sub
Sub ButtonThree()
PopulateGeographicArea Sheet1, Sheet2, Nothwest
DeleteRangeAndShiftUp
End Sub
Sub ButtonFour()
PopulateGeographicArea Sheet1, Sheet2, WestCentral
DeleteRangeAndShiftUp
End Sub
Sub ButtonFive()
PopulateGeographicArea Sheet1, Sheet2, EastCentral
DeleteRangeAndShiftUp
End Sub
Sub ButtonSix()
PopulateGeographicArea Sheet1, Sheet2, Southern
DeleteRangeAndShiftUp
End Sub
Sub ButtonSeven()
PopulateGeographicArea Sheet1, Sheet2, OutOfState
DeleteRangeAndShiftUp
End Sub
Private Sub PopulateGeographicArea(ByVal ws1 As Worksheet, ByVal ws2 As Worksheet, ByVal myRegion As GeographicArea, Optional ByRef K As Long = 10)
On Error Resume Next
ws2.Range(ws2.Cells(10, "A"), ws2.Cells(Rows.Count, "Z")).SpecialCells(xlCellTypeConstants).ClearContents
On Error GoTo -1
On Error GoTo DirtyExit
Dim lastRow As Long
lastRow = ws1.Cells(Rows.Count, myRegion).End(xlUp).Row
On Error GoTo -1
Dim i As Long
For i = 1 To lastRow
Dim cellContent As String
cellContent = ws1.Cells(i, "A").Value2 'Value2 doesn't have rounding issues like Value. For numbers doesnt produce ### like Text can.
If cellContent = "Contact Information" Then
K = K + 1
Else
PopulateInformation ws2, cellContent, K
End If
Next
CleanExit:
Exit Sub
DirtyExit:
MsgBox "Please ensure columns are correct for your regions", vbOKOnly, "Incorrect region was used"
End Sub
Private Sub PopulateInformation(ByVal populateSheet As Worksheet, ByVal content As String, ByVal checkRow As Long)
If content Like "Name:*" Then PopulateName populateSheet, content, checkRow
PopulateLicense populateSheet, content, checkRow
If content Like "License Status:*" Then PopulateLicenseStatus populateSheet, content, checkRow
If content Like "City/State:*" Then PopulateCityAndState populateSheet, content, checkRow
If content Like "County:*" Then PopulateCounty populateSheet, content, checkRow
If content Like "*Phone:*" Then PopulatePhoneNumber populateSheet, content, checkRow
If content Like "Email Address:*" Then PopulateEmailAddress populateSheet, content, checkRow
If content Like "Region:*" Then PopulateRegion populateSheet, content, checkRow
If content Like "Ever Been Disciplined?:*" Then PopulatePreviouslyDisciplined populateSheet, content, checkRow
End Sub
Private Sub PopulateName(ByVal ws As Worksheet, ByVal content As String, ByVal checkRow As Long)
ws.Cells(checkRow, 1) = Split(Split(content, ", ")(1), " ")(0) 'FirstName
ws.Cells(checkRow, 2) = Split(Split(content, ": ")(1), ",")(0) 'LastName
End Sub
Private Sub PopulateLicense(ByVal ws As Worksheet, ByVal content As String, ByVal checkRow As Long)
Dim license As String
If content Like "License:*" Then
license = Split(content, "- ")(1)
End If
If content Like "License: General - *" Then
license = Split(content, "- ")(1)
Else
If content Like "License:*" Then
license = Split(content, ": ")(1)
End If
End If
ws.Cells(checkRow, 3) = license
End Sub
Private Sub PopulateLicenseStatus(ByVal ws As Worksheet, ByVal content As String, ByVal checkRow As Long)
ws.Cells(checkRow, 4) = Split(content, ": ")(1)
End Sub
Private Sub PopulateCityAndState(ByVal ws As Worksheet, ByVal content As String, ByVal checkRow As Long)
Dim cityState As Variant
cityState = Split(Split(content, ": ")(1), ",")
ws.Cells(checkRow, 5) = cityState(0) 'City
ws.Cells(checkRow, 6) = cityState(1) 'State
End Sub
Private Sub PopulateCounty(ByVal ws As Worksheet, ByVal content As String, ByVal checkRow As Long)
ws.Cells(checkRow, 7) = Split(content, ": ")(1)
End Sub
Private Sub PopulatePhoneNumber(ByVal ws As Worksheet, ByVal content As String, ByVal checkRow As Long)
Dim columnOffset As Long
If content Like "Home*" Then
columnOffset = 0
ElseIf content Like "Work*" Then
columnOffset = 1
ElseIf content Like "Cell*" Then
columnOffset = 2
End If
Dim phoneNumber As String 'Assuming this is containing text
phoneNumber = Split(content, ": ")(1)
ws.Cells(checkRow, 8 + columnOffset) = phoneNumber
End Sub
Private Sub PopulateEmailAddress(ByVal ws As Worksheet, ByVal content As String, ByVal checkRow As Long)
ws.Cells(checkRow, 11) = Split(content, ": ")(1)
End Sub
Private Sub PopulateRegion(ByVal ws As Worksheet, ByVal content As String, ByVal checkRow As Long)
ws.Cells(checkRow, 12) = Split(content, ": ")(1)
End Sub
Private Sub PopulatePreviouslyDisciplined(ByVal ws As Worksheet, ByVal content As String, ByVal checkRow As Long)
ws.Cells(checkRow, 13) = Split(content, ": ")(1)
End Sub
Private Sub DeleteRangeAndShiftUp()
Sheet2.Range("H10:N10").Delete xlUp
End Sub
There are further optimizations that can be done but without running it I'm not exactly sure what they'll be. Any time you're about to copy/pasta stop. Think about what's being done and ask yourself if you can create a method (Sub
or Function
) that you can supply arguments to.
-
\$\begingroup\$ Wow, what a great explanation and write up! This has been extremely helpful. Also, a big thanks to @Mat's-Mug. I am still very new to vba and coding in general, I will probably have a lot of questions about your code. Please forgive delays between my responses. I study and experiment your code one thing at a time and my understanding may not be as quick as others. \$\endgroup\$C.Nug– C.Nug2017年11月09日 16:44:24 +00:00Commented Nov 9, 2017 at 16:44
So to begin with the biggest problem in your code is that you have written basically the same sub multiple times. However I see no problem using split if your data is consistent in terms of having the delimiter in each occurrence.
Also setting the vConstants and xConstants, which I'm a bit confused by without seeing the Sheet1, multiple times for each button is unnecessary. Something along the lines of:
Public selectedCol as Integer
Sub ButtonOne()
selectedCol = 1 ' Change this according to the button.
Call GetRegion(selectedCol)
End Sub
And for the main method itself:
Sub GetRegion(iCol as Integer)
Dim nRegion as long
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set vConstants = s2.Range("A10:Z99999").SpecialCells(xlCellTypeConstants)
Set xConstants = s2.Range("H10:N10")
K = 10
vConstants.ClearContents
On Error Resume Next
nRegion= s1.Cells(Rows.Count, iCol).End(xlUp).Row
For i = 1 To nRegion
v = s1.Cells(i, iCol).Text
If v = "Contact Information" Then
K = K + 1
Else
If v Like "Name:*" Then
s2.Cells(K, 1) = Split(Split(v, ", ")(1), " ")(0) 'First Name
s2.Cells(K, 2) = Split(Split(v, ": ")(1), ",")(0) 'Last Name
End If
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, "- ")(1)
If v Like "License: General - *" Then
s2.Cells(K, 3) = Split(v, "- ")(1)
Else
If v Like "License:*" Then s2.Cells(K, 3) = Split(v, ": ")(1)
End If
If v Like "License Status:*" Then s2.Cells(K, 4) = Split(v, ": ")(1)
If v Like "City/State:*" Then s2.Cells(K, 5) = Split(Split(v, ": ")(1), ",")(0)
If v Like "City/State:*" Then s2.Cells(K, 6) = Split(Split(v, ": ")(1), ", ")(1)
If v Like "County:*" Then s2.Cells(K, 7) = Split(v, ": ")(1)
If v Like "Home Phone:*" Then s2.Cells(K, 8) = Split(v, ": ")(1)
If v Like "Work Phone:*" Then s2.Cells(K, 9) = Split(v, ": ")(1)
If v Like "Cell Phone:*" Then s2.Cells(K, 10) = Split(v, ": ")(1)
If v Like "Email Address:*" Then s2.Cells(K, 11) = Split(v, ": ")(1)
If v Like "Region:*" Then s2.Cells(K, 12) = Split(v, ": ")(1)
If v Like "Ever Been Disciplined?:*" Then s2.Cells(K, 13) = Split(v, ": ")(1)
End If
Next i
xConstants.Delete xlUp
End Sub
Also I would consider using a combobox to select the region instead of multiple command buttons. You probably have the column headers in the Sheet2, but I would also consider populating them into an array and adding them in the beginning of the main sub.
Hopefully this helps. If you post the workbook I can look into it a bit better as I can't say much about the main sub itself without the data.
-
\$\begingroup\$ Let's ignore the lack of using With statement and the amount of the If clauses first. \$\endgroup\$Mikael Kajander– Mikael Kajander2017年11月08日 22:53:30 +00:00Commented Nov 8, 2017 at 22:53
<table class="soi-table table">
on the webpage. This would be fairly easy to parse. \$\endgroup\$cells(1,1) = "Contact Information"
thencells(11,1) = "Contact Information"
. If this is the case then we can step through the code 10 rows at a timeFor i = 1 to LastRow Step 10
\$\endgroup\$