2
\$\begingroup\$

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
asked Nov 8, 2017 at 21:10
\$\endgroup\$
6
  • \$\begingroup\$ Welcome to CR! You'll learn a ton - enjoy the ride! \$\endgroup\$ Commented Nov 8, 2017 at 21:28
  • 1
    \$\begingroup\$ I would recommend writing a better Web Scraper. Each informational entry is a row in a table <table class="soi-table table"> on the webpage. This would be fairly easy to parse. \$\endgroup\$ Commented Nov 9, 2017 at 0:39
  • 1
    \$\begingroup\$ Using your current data set and assuming that each entry is a set block of cells,it would be simpler to step through the entries 1 block at a time. For example: If each block is 10 rows and 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 time For i = 1 to LastRow Step 10 \$\endgroup\$ Commented Nov 9, 2017 at 0:50
  • 1
    \$\begingroup\$ The answer I posted isn't correct because it doesn't output the records in the correct format. However, this format is much easier to work with. I suggest that you use my answer to compile the information and then write a routine to process the records. \$\endgroup\$ Commented Nov 9, 2017 at 2:42
  • 1
    \$\begingroup\$ Whenever possible you should include sample or mock data in your post. You'll get much better responses by doing so. \$\endgroup\$ Commented Nov 9, 2017 at 2:43

3 Answers 3

2
\$\begingroup\$

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).

enter image description here

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#.#

VBA References

answered Nov 9, 2017 at 2:10
\$\endgroup\$
4
  • \$\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\$ Commented 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 because If v Like "License Status:*" Then one occurs there is no reason to test If v Like "City/State:*" Then. I recommended the Select Case statement to improve readability. \$\endgroup\$ Commented 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\$ Commented Nov 14, 2017 at 22:17
  • 1
    \$\begingroup\$ @C.Nug That is the way I would do it. \$\endgroup\$ Commented Nov 14, 2017 at 23:12
2
\$\begingroup\$

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.

answered Nov 9, 2017 at 0:29
\$\endgroup\$
1
  • \$\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\$ Commented Nov 9, 2017 at 16:44
1
\$\begingroup\$

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.

answered Nov 8, 2017 at 22:47
\$\endgroup\$
1
  • \$\begingroup\$ Let's ignore the lack of using With statement and the amount of the If clauses first. \$\endgroup\$ Commented Nov 8, 2017 at 22:53

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.