Macros not working in Excel 2013 but works fine in Excel 2007

[Techie1980]

Hi Guys,

We recently migrated to Excel 2013 and our macros running in Excel 2007 has stopped working. When we run it We get error 424: object required. on frmMain.Show

The guy who wrote has left and we are finding difficult debugging it. Help is greatly appreciated.

Below is the code:

---------------------------------------------
Public dobjName As String
Public dobjType As String
Public promptCode As String
Public theRange As String
Public theText As String


Option Base 1


Sub OpenfrmMain()
'
' OpenfrmMain Macro
'

'
frmMain.Show
End Sub

Public Sub WriteText_Reps(TextPrompt As String)
TextPrompt = Trim(TextPrompt)

With ThisWorkbook
writeRow = WorksheetFunction.CountA(.Worksheets("text_reps").Range("A:A")) + 1

seq = 1
If writeRow > 1 Then
If dobjName = .Worksheets("text_reps").Cells(writeRow - 1, 8).Value Then
seq = .Worksheets("text_reps").Cells(writeRow - 1, 9).Value + 1
End If
End If

If promptCode <> "" And seq = 1 Then
'If TextPrompt is made up of multiple sentences and ends with a question,
'send only the question portion of the string to the prompt_codes worksheet.
If Right(TextPrompt, 1) = "?" And (InStr(TextPrompt, ". ") Or InStr(TextPrompt, "! ")) Then
Writeprompt_codes promptCode, Mid(TextPrompt, _
Application.WorksheetFunction.max(InStrRev(TextPrompt, ". "), InStrRev(TextPrompt, "! ")) + 2)
Else
Writeprompt_codes promptCode, TextPrompt
End If

End If

.Worksheets("text_reps").Cells(writeRow, 1).Value = TextPrompt
.Worksheets("text_reps").Cells(writeRow, 2).Value = frmMain.LibraryID.Value
.Worksheets("text_reps").Cells(writeRow, 3).Value = frmMain.VoiceModelID.Value
.Worksheets("text_reps").Cells(writeRow, 4).Value = frmMain.FilePathID.Value
.Worksheets("text_reps").Cells(writeRow, 7).Value = frmMain.Language.Value
.Worksheets("text_reps").Cells(writeRow, 8).Value = dobjName
.Worksheets("text_reps").Cells(writeRow, 9).Value = seq
End With

End Sub

Public Sub WriteDOBJs()
With ThisWorkbook
writeRow = WorksheetFunction.CountA(.Worksheets("DOBJs").Range("A:A")) + 1
.Worksheets("DOBJs").Cells(writeRow, 1).Value = dobjName
.Worksheets("DOBJs").Cells(writeRow, 2).Value = dobjType
.Worksheets("DOBJs").Cells(writeRow, 3).Value = IIf(dobjType = "STATEMENT", "Statement", theRange)
.Worksheets("DOBJs").Cells(writeRow, 4).Value = promptCode
End With

End Sub

Public Sub Writepres_resps(TextPrompt As String, a As String, b As String, c As String)
With ThisWorkbook
writeRow = WorksheetFunction.CountA(.Worksheets("pres_resps").Range("A:A")) + 1
.Worksheets("pres_resps").Cells(writeRow, 1).Value = TextPrompt
.Worksheets("pres_resps").Cells(writeRow, 2).Value = a
.Worksheets("pres_resps").Cells(writeRow, 3).Value = b
.Worksheets("pres_resps").Cells(writeRow, 4).Value = c
End With
End Sub
Public Sub Writeprompt_codes(thisPrompt As String, TextPrompt As String)
With ThisWorkbook
writeRow = WorksheetFunction.CountA(.Worksheets("prompt_codes").Range("A:A")) + 1
.Worksheets("prompt_codes").Cells(writeRow, 1).Value = thisPrompt
.Worksheets("prompt_codes").Cells(writeRow, 2).Value = TextPrompt
End With
End Sub

Public Sub WriteParsed()
With ThisWorkbook
writeRow = WorksheetFunction.CountA(.Worksheets("parsed").Range("A:A")) + 1
.Worksheets("parsed").Cells(writeRow, 1).Value = frmMain.ContractCode.Value & "_" & dobjName
.Worksheets("parsed").Cells(writeRow, 2).Value = dobjType
.Worksheets("parsed").Cells(writeRow, 3).Value = promptCode
.Worksheets("parsed").Cells(writeRow, 4).Value = theRange
.Worksheets("parsed").Cells(writeRow, 5).Value = theText
End With
End Sub

Sub Load()


On Error GoTo errorExit



Dim oRange As Word.Range
Dim oTable As Word.Table
Dim par As Paragraph


Dim TextPrompt As String, TextRep As String, seq As Integer, pstart As Integer, _
paraText As String

With ThisWorkbook
.Worksheets("parsed").Cells.Clear

.Worksheets("parsed").Cells(1, 1).Value = "dobj_name"
.Worksheets("parsed").Cells(1, 2).Value = "dobj_type"
.Worksheets("parsed").Cells(1, 3).Value = "prompt_code"
.Worksheets("parsed").Cells(1, 4).Value = "range"
.Worksheets("parsed").Cells(1, 5).Value = "text"
End With


For p = 0 To frmMain.TablesToParse.ListCount - 1

If frmMain.TablesToParse.Selected(p) = True Then

frmMain.lblProgress.Width = 0
frmMain.lblProgress.Visible = True
frmMain.txtProgress.Visible = True

Set oTable = frmMain.WordDoc.Tables(p + 1)
Set oRange = oTable.Range

'Clean up range
oRange.Find.ClearFormatting
oRange.Find.Replacement.ClearFormatting
With oRange.Find
.Text = "^l"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oRange.Find.Execute Replace:=wdReplaceAll, Wrap:=wdFindStop

For i = 1 To oTable.Rows.Count 'skip through each row of the selected table(s)

With oTable.Rows(i).Cells(1)

frmMain.lblStatus.Caption = frmMain.TablesToParse.List(p) & "...row " & Str(i) & " of " & Str(oTable.Rows.Count)

dobjName = "*NOT FOUND*"
dobjType = ""
promptCode = ""
theRange = ""
theText = ""



lastCol = oTable.Columns.Count 'this is the last column of the table; it should contain the dobjname

If Len(Trim(Application.WorksheetFunction.Clean(Replace(oTable.Rows(i).Cells(lastCol).Range.Text, Chr(160), " ")))) <> 0 Then 'The cell contains dobj name (or "Range" statement).

'dobjType = IIf(.Shading.BackgroundPatternColorIndex = 0, "STATEMENT", "QUESTION")

With .Shading
If (.BackgroundPatternColorIndex <> 0 Or .Texture <> 0) And .BackgroundPatternColor <> wdColorWhite Then
dobjType = "QUESTION"
Else
dobjType = "STATEMENT"
End If
End With



'Inspect the last column of the table to get dialogue object name and/or range.
'ONLY the last occurence of either will be used.
For Each par In oTable.Rows(i).Cells(lastCol).Range.Paragraphs
paraText = Trim(Application.WorksheetFunction.Clean(Replace(par.Range.Text, Chr(160), " ")))
If UCase(Left(paraText, 6)) = "RANGE " Then 'a range has been assigned
theRange = Replace(paraText, " ", "")
ElseIf paraText <> "" Then
dobjName = paraText
End If
Next

For Each par In oTable.Rows(i).Cells(1).Range.Paragraphs
If Len(Trim(Application.WorksheetFunction.Clean(Replace(par.Range.Text, Chr(160), " ")))) > 0 Then 'The paragraph contains text
theText = theText & Trim(Application.WorksheetFunction.Clean(Replace(par.Range.Text, Chr(160), " "))) & " "
End If
Next par

If Len(dobjName) = 10 _
And UCase(Left(dobjName, 6)) = frmMain.ContractCode.Value _
And IsNumeric(Right(dobjName, 4)) Then 'this is a prompt code.
promptCode = dobjName
End If

WriteParsed

End If

End With


Completed = i / oTable.Rows.Count
frmMain.lblProgress.Width = Completed * frmMain.lblStatus.Width
DoEvents


Next i


End If
Next p



Set oRange = Nothing
Set oTable = Nothing
Set par = Nothing

frmMain.lblProgress.Visible = False
frmMain.txtProgress.Visible = False
Exit Sub

errorExit:
Set oRange = Nothing
Set oTable = Nothing
Set par = Nothing
MsgBox "ERROR: " + Err.Description, vbCritical + vbOKOnly, title
Exit Sub



End Sub


Sub Parse()
'populate prompt code and pres resps
'ActiveWorkbook.Sheets("parsed").Activate
delPhraseString = "To |If you |If your |If it |If they |If " 'these are phrases to remove from the beginning of the ", press " instructions
delPhrase = Split(delPhraseString, "|")

Dim respValue As String, respValue2 As String, respInterp As String, thisRange As String

With ThisWorkbook
.Worksheets("dobjs").Cells.Clear
.Worksheets("text_reps").Cells.Clear
.Worksheets("prompt_codes").Cells.Clear
.Worksheets("pres_resps").Cells.Clear
End With

lastParsedRow = WorksheetFunction.CountA(ThisWorkbook.Worksheets("parsed").Range("A:A"))
For parsedRow = 2 To lastParsedRow
With ThisWorkbook
dobjName = .Worksheets("parsed").Cells(parsedRow, 1).Value
dobjType = .Worksheets("parsed").Cells(parsedRow, 2).Value
promptCode = .Worksheets("parsed").Cells(parsedRow, 3).Value
theRange = .Worksheets("parsed").Cells(parsedRow, 4).Value
theText = .Worksheets("parsed").Cells(parsedRow, 5).Value
End With

'Change all occurences of multiple space to single space.
Do While InStr(theText, " ") > 0
theText = Replace(theText, " ", " ")
Loop

'Remove any spaces that follow a left curly bracket.
theText = Replace(theText, "{ ", "{")

'Remove program and logic comments. Leave a left curly bracket for each occurence of the "INSERT" type.
theStart = InStr(theText, "{")
Do While theStart > 0
theEnd = InStr(theStart, theText, "}")
If theEnd > 0 Then
theText = Left(theText, theStart - 1) & IIf(UCase(Mid(theText, theStart, 7)) = "{INSERT", "{", "") & Mid(theText, theEnd + 1)
theStart = InStr(theStart + 1, theText, "{")
Else
theStart = 0
End If
Loop


If dobjType = "QUESTION" Then 'this is a question

If InStr(theText, "?") > 0 Then 'put the text leading up to - and including - the question mark (?) on it's own line.
WriteText_Reps Left(theText, InStr(theText, "?"))
theText = Trim(Mid(theText, InStr(theText, "?") + 1))
End If

If Trim(theText) <> "" Then
WriteText_Reps theText

respInterp = ""
respValue = ""
respValue2 = ""

If theRange <> "" Then 'range has been explicitly provided in IVR document.
respValue = Mid(theRange, 6, InStr(theRange, "-") - 6)
respValue2 = Mid(theRange, InStr(theRange, "-") + 1)

If promptCode <> "" Then 'write pres_resp.
'Assume that the directive takes the form "Enter the...now."
'Find the first occurence of "ENTER THE " and the first occurence of " NOW."
'that follows it. The text in between will be considerred the respInterp.
If InStr(UCase(theText), "ENTER THE ") > 0 Then
respInterp = Mid(theText, InStr(UCase(theText), "ENTER THE ") + 10)
If InStr(UCase(respInterp), " NOW.") Then
respInterp = Mid(respInterp, 1, InStr(UCase(respInterp), " NOW.") - 1)
End If
End If
Writepres_resps promptCode, respValue, respValue2, respInterp
End If

ElseIf InStr(theText, ", press ") > 0 Then 'treat as "If x, press n." directive.
Do While InStr(theText, ", press ") > 0

respValue = Mid(theText, InStr(theText, ", press ") + 8, _
InStr(InStr(theText, ", press "), theText, ".") - InStr(theText, ", press ") - 8)

theRange = theRange & respValue & "|"

respInterp = ""
For r = 0 To UBound(delPhrase)
If InStr(theText, delPhrase(r)) = 1 Then
respInterp = Replace(theText, delPhrase(r), "", , 1)
respInterp = Left(respInterp, InStr(respInterp, ", press ") - 1)
Exit For
End If
Next r

If promptCode <> "" Then 'write pres_resp.
Writepres_resps promptCode, respValue, "", respInterp
End If

theText = Trim(Mid(theText, InStr(InStr(theText, ", press "), theText, ".") + 1))

Loop

rangeParse = Split(theRange, "|")
theRange = "Range" & rangeParse(0) & "-" & rangeParse(UBound(rangeParse) - 1)

ElseIf InStr(UCase(theText), "CHOOSE ANY NUMBER FROM") > 0 Then
respParsed = Split(Mid(theText, InStr(UCase(theText), "CHOOSE ANY NUMBER FROM")), " ")
respValue = respParsed(4)
respValue2 = Replace(respParsed(6), ",", "")
theRange = "Range" & respValue & "-" & respValue2

If promptCode <> "" Then 'write pres_resp.
respInterp = Left(respParsed(UBound(respParsed)), Len(respParsed(UBound(respParsed))) - 1)
Writepres_resps promptCode, respValue, respValue2, respInterp
End If

ElseIf promptCode <> "" Then
respInterp = "ERROR: Unable to determine response interpretation."
Writepres_resps dobjName, respValue, respValue2, respInterp
End If
End If

ElseIf dobjType = "STATEMENT" Then 'this is a statement.

If Len(theText) > frmMain.maxString.Value Then
theText = Replace(theText, ". ", ".|")

'Splitting at the period + space is not sufficient as a period + space may be used to abbreviate and
'not necessarily to indicate the end of a sentence. Instead, we will look for period + space + initial capital
'as (most likely) indication of where to split two sentences.

textsplit = Split(theText, "|")
theText = textsplit(0)
For s = 1 To UBound(textsplit)
If Left(textsplit(s), 1) <> UCase(Left(textsplit(s), 1)) Then
theText = theText & " " & textsplit(s)
Else
theText = theText & "|" & textsplit(s)
End If
Next s

theText = Replace(theText, "?", "?|")
theText = Replace(theText, "!", "!|")

textsplit = Split(theText, "|")

theText = textsplit(0)
For s = 1 To UBound(textsplit)
If Len(theText & " " & textsplit(s)) > frmMain.maxString.Value Then
WriteText_Reps theText
theText = textsplit(s)
Else
theText = theText & " " & textsplit(s)
End If

Next s

End If

WriteText_Reps theText


End If

WriteDOBJs

Next parsedRow

Prod.InsertScan


End Sub

Sub Verify()
'check for lines greate than length of x
'check for empty cells

End Sub
Sub InsertScan()

With ThisWorkbook.Worksheets("text_reps")

r = 1
Do While .Cells(r, 8).Value <> ""

varInsert = InStr(.Cells(r, 1).Value, "{")
If varInsert > 0 Then

firstHalf = Trim(Left(.Cells(r, 1).Value, varInsert - 1))
secondHalf = Trim(Mid(.Cells(r, 1).Value, varInsert + 1))

If Len(firstHalf) = 0 Then
.Rows(r).EntireRow.Insert
.Cells(r, 2).Value = .Cells(r + 1, 2).Value 'frmMain.LibraryID.Value
.Cells(r, 3).Value = .Cells(r + 1, 3).Value 'frmMain.VoiceModelID.Value
.Cells(r, 4).Value = .Cells(r + 1, 4).Value 'frmMain.FilePathID.Value
.Cells(r, 7).Value = .Cells(r + 1, 7).Value 'frmMain.Language.Value
.Cells(r, 8).Value = .Cells(r + 1, 8).Value 'dobjName
.Cells(r + 1, 1).Value = secondHalf

Else
.Cells(r, 1).Value = firstHalf
.Rows(r + 1).EntireRow.Insert
.Cells(r + 1, 2).Value = .Cells(r, 2).Value 'frmMain.LibraryID.Value
.Cells(r + 1, 3).Value = .Cells(r, 3).Value 'frmMain.VoiceModelID.Value
.Cells(r + 1, 4).Value = .Cells(r, 4).Value 'frmMain.FilePathID.Value
.Cells(r + 1, 7).Value = .Cells(r, 7).Value 'frmMain.Language.Value
.Cells(r + 1, 8).Value = .Cells(r, 8).Value 'dobjName
If Len(secondHalf) > 0 Then
.Rows(r + 2).EntireRow.Insert
.Cells(r + 2, 1).Value = secondHalf
.Cells(r + 2, 2).Value = .Cells(r, 2).Value 'frmMain.LibraryID.Value
.Cells(r + 2, 3).Value = .Cells(r, 3).Value 'frmMain.VoiceModelID.Value
.Cells(r + 2, 4).Value = .Cells(r, 4).Value 'frmMain.FilePathID.Value
.Cells(r + 2, 7).Value = .Cells(r, 7).Value 'frmMain.Language.Value
.Cells(r + 2, 8).Value = .Cells(r, 8).Value 'dobjName
r = r + 1
End If
End If
End If

r = r + 1

Loop

r = 1
Do While .Cells(r, 8).Value <> ""
dobjName = .Cells(r, 8).Value
sequence = 1
Do While .Cells(r, 8).Value = dobjName

If Len(.Cells(r, 1).Value) > 1 Then
.Cells(r, 9).Value = sequence
sequence = sequence + 1
ElseIf .Cells(r, 1).Value = "" Then 'row is blank.
.Rows(r).EntireRow.Delete
r = r - 1
sequence = sequence + 1
Else '(assume) row includes punctuation only.
.Rows(r).EntireRow.Delete
r = r - 1
End If

r = r + 1
Loop

Loop
End With

End Sub

Sub Validate()
'Check for dobj name greater than 30 characters
'Check for duplicate dialogue object names
'Check for duplicate dialogue object text
End Sub

Function Occurs(ByVal searchText As String, ByVal findText As String) As Integer
Occurs = 0
Start = 1
Do While InStr(Start, searchText, findText) > 0
Occurs = Occurs + 1
Start = InStr(Start, searchText, findText) + 1

Loop

End Function

 

[Techie1980]

Guys to add to it. Error 424 shows up when we click the parse button which should technically open a user form with textboxes, checkbox and button but it just shows error 424bject required error