Cleaning Data: "Mon - Fri" or "Sat through Thurs" - excel

Question

I have an excel spreadsheet with 50000 rows of business hours data (in every conceivable format):
THU 4P-9P F 9A-9P SAT,SUN 9A-6P
WED & THU 10A - 3P FRI 10A - 1P
MON - FRI 6P - 10P
M - SA 9A - 9P
SUN-SAT 9-5
SU - SA 8A- 10P
TUE - FRI 10A - 6P SAT 12P - 4P
MON - FRI 730A-4P / SAT 9A-12P
SUN 6A-5P / M-F 6A-9P / SAT 5A-9P
I need to convert it to something like:
Days Open A Week: 2
Hours Open a Week: 15
I thought of doing:
Business Hours Sunday
WED 1P - 5P THU - SA BY APPT =ISNUMBER(SEARCH("Sun",A1)) # returns True.
for each day, but I'm wondering if there is an easier way to clean this data other than hard coding every possibility.
Thank you!

Answer 1

Here's some VBA that worked on the sample data provided. It almost certainly won't work on a larger sample, but it's a start.
Public Function DaysAndHours(ByVal sInput As String)
Dim vaTokens As Variant
Dim i As Long, j As Long
Dim vaSeps As Variant
Dim dtTime As Date, dtStart As Date, dtEnd As Date
Dim dHours As Double, dTodayHours As Double
Dim lStartDay As Long, lEndDay As Long
Dim bThrough As Boolean
Dim dcDay As Scripting.Dictionary
Dim vItem As Variant
Set dcDay = New Scripting.Dictionary
'These are all the characters that split the data
'as you discover more characters, add them here
vaSeps = Split("- , / &")
'If the data has times like 730, Excel can't tell it's a time
'so this adds a colon before 30 and 15 assuming it's unlikely
'anyone would open or close on other than a quarter hour
'then if there was already a colon there, it would be doubled
'so remove double colons
sInput = Replace(sInput, "30", ":30")
sInput = Replace(sInput, "15", ":15")
sInput = Replace(sInput, "::", ":")
'Some separators have spaces around them and some don't. This changes
'all separators so they have spaces. This is so our split creates
'proper tokens
For j = LBound(vaSeps) To UBound(vaSeps)
sInput = Replace(sInput, vaSeps(j), Space(1) & vaSeps(j) & Space(1))
Next j
'If the separators already had spaces around them, they would be
'doubled. Trim removes double spaces
sInput = Application.Trim(sInput)
vaTokens = Split(sInput, Space(1))
'Assume the first token is a day, and put it in the
'dictionary at zero hours
lStartDay = GetDayFromInit(vaTokens(LBound(vaTokens)))
dcDay.Add lStartDay, 0
For i = LBound(vaTokens) + 1 To UBound(vaTokens)
'Some separators are "through" meaning that all the days in between
'the two days are included. Other separators just list discrete days
If IsSep(vaTokens(i), vaSeps) Then
Select Case vaTokens(i)
Case "-"
bThrough = True
Case Else
bThrough = False
End Select
Else
'Excel won't convert a straight number to a time, so this
'adds :00 to make it look like a time
If IsNumeric(vaTokens(i)) Then
vaTokens(i) = vaTokens(i) & ":00"
End If
'Try to change the token into a time. If it
'works, we're dealing with times, otherwise days
On Error Resume Next
dtTime = TimeValue(vaTokens(i))
On Error GoTo 0
If dtTime > 0 Then 'the current token is a time
If dtStart > 0 Then 'we've already converted a time, so this must be the end time
dtEnd = dtTime
If dtEnd < dtStart Then dtEnd = dtEnd + TimeSerial(12, 0, 0) 'make sure the end time is after the start time
dTodayHours = dtEnd - dtStart 'compute the hours open
'For every day that we haven't filled a time, put this time
For j = 0 To dcDay.Count - 1
If dcDay.Items(j) = 0 Then
dcDay.Item(dcDay.Keys(j)) = dTodayHours
End If
Next j
dtStart = 0: dtEnd = 0: dtTime = 0 'reset
bThrough = False 'reset
Else 'We haven't already filled a time, so this must be the start time
dtStart = dtTime
End If
Else 'the current token isn't a time, it must be day
'we've encountered a through separator, so we've alreay got a start day
'and this token is the end day
If bThrough Then
lEndDay = GetDayFromInit(vaTokens(i))
'If the days are in the right order, just add them
'in order to the dictionary
If lStartDay < lEndDay Then
For j = lStartDay To lEndDay
If Not dcDay.Exists(j) Then
dcDay.Add j, 0
End If
Next j
Else 'Days are in the wrong order (where Sunday = 1)
For j = 1 To lEndDay
If Not dcDay.Exists(j) Then
dcDay.Add j, 0
End If
Next j
For j = lStartDay To 7
If Not dcDay.Exists(j) Then
dcDay.Add j, 0
End If
Next j
End If
Else 'We haven't encountered a through operator, so this is a lone day or the first of a range
lStartDay = GetDayFromInit(vaTokens(i))
If Not dcDay.Exists(lStartDay) Then
dcDay.Add lStartDay, 0
End If
End If
End If
End If
Next i
DaysAndHours = dcDay.Count & " days, " & Application.Sum(dcDay.Items) * 24 & " hours"
End Function
Public Function GetDayFromInit(ByVal sInit As String) As Long
Dim vaDays As Variant
Dim i As Long
vaDays = Split("SUNDAY MONDAY TUESDAY WEDNESDAY THURSDAY FRIDAY SATURDAY")
For i = 0 To 6
If UCase(sInit) = Left$(vaDays(i), Len(sInit)) Then
GetDayFromInit = i + 1
Exit For
End If
Next i
End Function
Public Function IsSep(ByVal sChar As String, ByRef vSeps As Variant) As Boolean
IsSep = InStr(1, Join(vSeps), sChar)
End Function