[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 69
  • Last Modified:

Updating the status in a listbox

So I have this form in Excel which works wonderfully thanks to the experts here.
I have one particular button that can take about 10 minutes to run.

I would like a listbox to display when the user clicks on [Run All] and in the list box it shows all the tasks that need to be completed and checks them off as they are completed.

I saw an example on the site with a link to this site:
http://dailydoseofexcel.com/archives/2007/02/10/yet-another-progress-bar/

But I don't know how to tell the listbox to update when the [Run All] code moves to the next section in it's code..  There are a total of 5 tasks that need to be completed.

Thanks
John
0
John Sheehy
Asked:
John Sheehy
  • 10
  • 6
  • 2
1 Solution
 
Dale FyeCommented:
Generally, I have a table (tblTasksToComplete), which I populate with four columns TaskID, Complete (Y/N), Task (text), and TaskFunction (Text, visible = No).  Rather than use a listbox, I like to use a subform, so that I can display a checkbox for the Complete column.

When I start this process, I would load this table with the appropriate values from some other source.  This would probably be in the form of one or more append queries.

I would then create a recordset based on this subform, and loop through the records in the subform to perform the function associated with the TaskFunction column.  The key to this process is that the value in the TaskFunction column should actually be the name of a function you want to call, along with the associated parameters.  As an example, you might have a function fnTask1 either in a public code module or in the current forms code module.  In my Table, I might have values 1, FALSE, "Task #1", "fnTask1()".

To start the process of looping, I would do something like:

Dim rsTask as DAO.Recordset
Dim bComplete as boolean 
set rsTask = me.sub_Tasks.Recordsetclone

Do While not rs.eof
    rsTask.Edit
    bComplete = Eval(rsTask!TaskFunction)
    rsTask!Complete = bComplete 
    rsTask.Update
    'This will display the check in the checkbox associated with the Complete field.
    me.sub_Tasks.Refresh    
    if bComplete = False then
        msgbox "Unable to complete the process, process failed at: " & rsTask!TaskName
        Exit Do
    Else
        rsTask.MoveNext
    Endif
Loop

Open in new window

The key to this is that the using the Eval( ) function, I can pass the value of a field in the recordset to execute a specific function within my database, and can then return either a boolean value which will be stored in the bComplete variable.

You might include another column which indicates whether the current task must be completed before the one after it, and adjust the logic of the If Then/Else statement above accordingly.
0
 
John SheehySecurity AnalystAuthor Commented:
Can I use that in Excel?
0
 
Martin LissOlder than dirtCommented:
How about something as simple as this?
Q-28572481.xlsm
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
Dale FyeCommented:
Sorry, I missed the reference to XL.  You could use a listbox instead of a subform, but would have to display "Yes" or "No" in the Completed column rather than have a checkbox.  I'm sure Martin's solution will work, they always do.  If not, I'll revisit this in the morning.

Dale
0
 
John SheehySecurity AnalystAuthor Commented:
How do I take what Martin has and incorporate it in to this?  I want it to update the check box every time it moves onto the next part of the code, such as CNE then LHC then LHCSN then LHCT then PIDS.

John

Private Sub CMD_RUNALL_Click()
xMsg = MsgBox("Are you sure you want to Continue, this could take longer than five (5) minutes??", vbYesNo, "Proceed with Export?")
        If xMsg = vbYes Then
            GoTo MoveOn
        Else
            GoTo gracefulExit
        End If

MoveOn:

Set ws = ThisWorkbook.Sheets("CNE")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.CNE_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

GoTo LHC

LHC:
Set ws = ThisWorkbook.Sheets("LHC")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.LHC_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

GoTo LHCSN

LHCSN:
Set ws = ThisWorkbook.Sheets("LHCSN")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.LHCSN_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

GoTo LHCT

LHCT:
Set ws = ThisWorkbook.Sheets("LHCT")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.LHCT_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

Set ws = ThisWorkbook.Sheets("PIDS")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.PIDS_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

gracefulExit:
    Application.StatusBar = False
    'objWord.Quit True
    Set objWord = Nothing
    xMsg = MsgBox("Export Completed Successfully", vbOKOnly, "SUCCESS!!!")


End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
Private Sub CMD_RUNALL_Click()
xMsg = MsgBox("Are you sure you want to Continue, this could take longer than five (5) minutes??", vbYesNo, "Proceed with Export?")
        If xMsg = vbYes Then
            GoTo MoveOn
        Else
            GoTo gracefulExit
        End If

MoveOn:

Set ws = ThisWorkbook.Sheets("CNE")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open Cos

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.CNE_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs Filename:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

Sheets("sheet1").ListBox1.Selected(0) = True
GoTo LHC

LHC:
Set ws = ThisWorkbook.Sheets("LHC")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open Cos

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.LHC_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs Filename:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

GoTo LHCSN
Sheets("sheet1").ListBox1.Selected(1) = True
LHCSN:
Set ws = ThisWorkbook.Sheets("LHCSN")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open Cos

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.LHCSN_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs Filename:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

GoTo LHCT
Sheets("sheet1").ListBox1.Selected(2) = True
LHCT:
Set ws = ThisWorkbook.Sheets("LHCT")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open Cos

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.LHCT_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs Filename:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

Set ws = ThisWorkbook.Sheets("PIDS")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open Cos

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.PIDS_Path & "\" & ws.Range("D" & i).Value & ".docx"
Sheets("sheet1").ListBox1.Selected(3) = True
objWord.ActiveDocument.SaveAs Filename:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

gracefulExit:
    Application.StatusBar = False
    'objWord.Quit True
    Set objWord = Nothing
    xMsg = MsgBox("Export Completed Successfully", vbOKOnly, "SUCCESS!!!")


End Sub
0
 
Martin LissOlder than dirtCommented:
BTW your code that looks like this
GoTo LHC

LHC:

Open in new window

is not good programming practice in that unless there's a very good reason for doing it (and that's very rare) you should only use GoTo in error-handling situations. In your case they don't seem necessary at all unless you have code between the GoTo and the label that you aren't showing us, and even then you probably don't need them.
0
 
Martin LissOlder than dirtCommented:
I see I made a couple of mistakes in my code. In the cases like this:
GoTo LHCSN
Sheets("sheet1").ListBox1.Selected(1) = True
LHCSN:

Open in new window

they should be
Sheets("sheet1").ListBox1.Selected(1) = True
GoTo LHCSN
LHCSN:

Open in new window

0
 
Martin LissOlder than dirtCommented:
Sorry for all these posts but as an example of getting rid of GoTo's, you could change this
xMsg = MsgBox("Are you sure you want to Continue, this could take longer than five (5) minutes??", vbYesNo, "Proceed with Export?")
        If xMsg = vbYes Then
            GoTo MoveOn
        Else
            GoTo gracefulExit
        End If

MoveOn:

Open in new window

to this.
If MsgBox("Are you sure you want to Continue, this could take longer than five (5) minutes??", vbYesNo, "Proceed with Export?") = vbNo Then
    Application.StatusBar = False
    'objWord.Quit True
    Set objWord = Nothing
    Exit Sub
End If

Open in new window

0
 
John SheehySecurity AnalystAuthor Commented:
Martin,

Thanks for the quick response.  I can't say I am a newbie to programming, but I am self taught and I go with what I know works.  Hence why you see so many goto statements.  I wasn't sure how the code would react once it finished running the first part and how it would move onto the next part.  So when it finished up with the CNE section how it would move onto the LHC section and so forth.

Each section CNE/LHC and so on are actually also separate buttons on the form.  The user has the choice to run them all at once or run each one individually.  

I was going to use a call statement for each so I didn't have to rewrite all the code.
Such as Call CMD_RUN_CNE_Click

But I wasn't sure where to enter the error handling and the progress update.

Attached is the whole forms code if you want to look at it.  I am always open to suggestions on how to make things better, proper and run effectively.

I will incorporate your snippets here in a bit.

Thanks
John
Dim objWord As Object
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim FileName As String, strPath As String
Dim xMsg1, xMsg2, xMsg3, xMsg As Long
Dim COS As String

Private Sub CMD_Close_Click()
Main_Form.Hide
End Sub

Private Sub CMD_CNE_Path_Click()
Set myFolder = Application.FileDialog(msoFileDialogFolderPicker)
 With myFolder
 .Title = "CHOOSE THE FOLDER WHERE THE CNE CO'S WILL BE STORED"
 .AllowMultiSelect = False
 If .Show <> -1 Then
 Exit Sub
 End If
 FolderSelected = .SelectedItems(1)
 End With

Me.CNE_Path = FolderSelected
End Sub

Private Sub CMD_CO_Path_Click()

Set myFolder = Application.FileDialog(msoFileDialogFolderPicker)
 With myFolder
 .Title = "CHOOSE THE FOLDER WHERE THE SAMPLE_CO.DOCX FILE TEMPLATE IS STORED"
 .AllowMultiSelect = False
 If .Show <> -1 Then
 Exit Sub
 End If
 FolderSelected = .SelectedItems(1)
 End With

Me.CO_Path = FolderSelected & "\Sample_CO.docx"
COS = Me.CO_Path
End Sub

Private Sub CMD_LHC_Path_Click()

Set myFolder = Application.FileDialog(msoFileDialogFolderPicker)
 With myFolder
 .Title = "CHOOSE THE FOLDER WHERE THE LHC CO'S WILL BE STORED"
 .AllowMultiSelect = False
 If .Show <> -1 Then
 Exit Sub
 End If
 FolderSelected = .SelectedItems(1)
 End With

Me.LHC_Path = FolderSelected

End Sub

Private Sub CMD_LHCSN_Path_Click()

Set myFolder = Application.FileDialog(msoFileDialogFolderPicker)
 With myFolder
 .Title = "CHOOSE THE FOLDER WHERE THE LHCSN CO'S WILL BE STORED"""
 .AllowMultiSelect = False
 If .Show <> -1 Then
 Exit Sub
 End If
 FolderSelected = .SelectedItems(1)
 End With

Me.LHCSN_Path = FolderSelected
End Sub

Private Sub CMD_LHCT_Path_Click()

Set myFolder = Application.FileDialog(msoFileDialogFolderPicker)
 With myFolder
 .Title = "CHOOSE THE FOLDER WHERE THE LHCT CO'S WILL BE STORED"""
 .AllowMultiSelect = False
 If .Show <> -1 Then
 Exit Sub
 End If
 FolderSelected = .SelectedItems(1)
 End With

Me.LHCT_Path = FolderSelected
End Sub

Private Sub CMD_PIDS_Path_Click()

Set myFolder = Application.FileDialog(msoFileDialogFolderPicker)
 With myFolder
 .Title = "CHOOSE THE FOLDER WHERE THE PIDS CO'S WILL BE STORED"""
 .AllowMultiSelect = False
 If .Show <> -1 Then
 Exit Sub
 End If
 FolderSelected = .SelectedItems(1)
 End With

Me.PIDS_Path = FolderSelected

End Sub

Private Sub CMD_RUN_CNE_Click()

Set ws = ThisWorkbook.Sheets("CNE")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

xMsg1 = MsgBox("Are you sure you want to Continue, this could take longer than two (2) minutes??", vbYesNo, "Proceed with Export?")
        If xMsg1 = vbYes Then
            GoTo MoveOn
        Else
            GoTo gracefulExit
        End If
MoveOn:

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

'objWord.Visible = True

Application.StatusBar = "Update Word From Excel: Initialization..."


objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.CNE_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

gracefulExit:
    Application.StatusBar = False
    'objWord.Quit True
    Set objWord = Nothing
    xMsg2 = MsgBox("Export Completed Successfully", vbOKOnly, "SUCCESS!!!")
End Sub

Private Sub CMD_RUN_LHC_Click()
Set ws = ThisWorkbook.Sheets("LHC")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

xMsg1 = MsgBox("Are you sure you want to Continue, this could take longer than two (2) minutes??", vbYesNo, "Proceed with Export?")
        If xMsg1 = vbYes Then
            GoTo MoveOn
        Else
            GoTo gracefulExit
        End If
MoveOn:

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

'objWord.Visible = True

Application.StatusBar = "Update Word From Excel: Initialization..."


objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.CNE_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

gracefulExit:
    Application.StatusBar = False
    'objWord.Quit True
    Set objWord = Nothing
    xMsg2 = MsgBox("Export Completed Successfully", vbOKOnly, "SUCCESS!!!")
End Sub

Private Sub CMD_RUN_LHCSN_Click()
Set ws = ThisWorkbook.Sheets("LHCSN")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

xMsg1 = MsgBox("Are you sure you want to Continue, this could take longer than two (2) minutes??", vbYesNo, "Proceed with Export?")
        If xMsg1 = vbYes Then
            GoTo MoveOn
        Else
            GoTo gracefulExit
        End If
MoveOn:

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

'objWord.Visible = True

Application.StatusBar = "Update Word From Excel: Initialization..."


objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.CNE_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

gracefulExit:
    Application.StatusBar = False
    'objWord.Quit True
    Set objWord = Nothing
    xMsg2 = MsgBox("Export Completed Successfully", vbOKOnly, "SUCCESS!!!")
End Sub

Private Sub CMD_RUN_LHCT_Click()
Set ws = ThisWorkbook.Sheets("LHCT")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

xMsg1 = MsgBox("Are you sure you want to Continue, this could take longer than two (2) minutes??", vbYesNo, "Proceed with Export?")
        If xMsg1 = vbYes Then
            GoTo MoveOn
        Else
            GoTo gracefulExit
        End If
MoveOn:

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

'objWord.Visible = True

Application.StatusBar = "Update Word From Excel: Initialization..."


objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.CNE_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

gracefulExit:
    Application.StatusBar = False
    'objWord.Quit True
    Set objWord = Nothing
    xMsg2 = MsgBox("Export Completed Successfully", vbOKOnly, "SUCCESS!!!")

End Sub

Private Sub CMD_RUN_PIDS_Click()
Set ws = ThisWorkbook.Sheets("PIDS")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

xMsg1 = MsgBox("Are you sure you want to Continue, this could take longer than two (2) minutes??", vbYesNo, "Proceed with Export?")
        If xMsg1 = vbYes Then
            GoTo MoveOn
        Else
            GoTo gracefulExit
        End If
MoveOn:

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

'objWord.Visible = True

Application.StatusBar = "Update Word From Excel: Initialization..."


objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.CNE_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

gracefulExit:
    Application.StatusBar = False
    'objWord.Quit True
    Set objWord = Nothing
    xMsg2 = MsgBox("Export Completed Successfully", vbOKOnly, "SUCCESS!!!")

End Sub

Private Sub CMD_RUNALL_Click()

xMsg = MsgBox("Are you sure you want to Continue, this could take longer than five (5) minutes??", vbYesNo, "Proceed with Export?")
        If xMsg = vbYes Then
            GoTo MoveOn
        Else
            GoTo gracefulExit
        End If

MoveOn:

Set ws = ThisWorkbook.Sheets("CNE")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.CNE_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

GoTo LHC

LHC:
Set ws = ThisWorkbook.Sheets("LHC")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.LHC_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

GoTo LHCSN

LHCSN:
Set ws = ThisWorkbook.Sheets("LHCSN")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.LHCSN_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

GoTo LHCT

LHCT:
Set ws = ThisWorkbook.Sheets("LHCT")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.LHCT_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

Set ws = ThisWorkbook.Sheets("PIDS")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
Set objWord = CreateObject("Word.Application")

Application.StatusBar = "Update Word From Excel: Initialization..."

objWord.Documents.Open COS

With objWord.ActiveDocument
.Bookmarks("CO").Range.Text = ws.Range("D" & i).Value
.Bookmarks("Author").Range.Text = ws.Range("I" & i).Value
.Bookmarks("Requirement_Number").Range.Text = ws.Range("E" & i).Value
.Bookmarks("Doors_ID").Range.Text = ws.Range("C" & i).Value
.Bookmarks("Title").Range.Text = ws.Range("F" & i).Value
.Bookmarks("Description").Range.Text = ws.Range("G" & i).Value
.Bookmarks("Verification_Method").Range.Text = ws.Range("H" & i).Value
.Bookmarks("Success_Criteria").Range.Text = ws.Range("J" & i).Value
.Bookmarks("Success_Criteria_1").Range.Text = ws.Range("K" & i).Value
.Bookmarks("Success_Criteria_2").Range.Text = ws.Range("L" & i).Value
.Bookmarks("Unclassified").Range.Text = ws.Range("M" & i).Value
.Bookmarks("Unclassified_1").Range.Text = ws.Range("N" & i).Value
.Bookmarks("Unclassified_2").Range.Text = ws.Range("O" & i).Value
.Bookmarks("Data_Requirements").Range.Text = ws.Range("P" & i).Value
.Bookmarks("Data_Requirements_1").Range.Text = ws.Range("Q" & i).Value
.Bookmarks("Data_Requirements_2").Range.Text = ws.Range("R" & i).Value

strPath = Me.PIDS_Path & "\" & ws.Range("D" & i).Value & ".docx"

objWord.ActiveDocument.SaveAs FileName:=strPath, _
AddToRecentFiles:=False
objWord.Quit False

End With

Next i

gracefulExit:
    Application.StatusBar = False
    'objWord.Quit True
    Set objWord = Nothing
    xMsg = MsgBox("Export Completed Successfully", vbOKOnly, "SUCCESS!!!")


End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
I wasn't sure how the code would react once it finished running the first part and how it would move onto the next part.
Code execution proceeds line by line unless interrupted by an error.

Here is how to handle the one-at-a-time execution versus the all-at-onece execution.

Sub Process1()
    ' some code
    Sheets("sheet1").ListBox1.Selected(0) = True
End Sub

Open in new window

Sub Process2()
    ' some code
    Sheets("sheet1").ListBox1.Selected(1) = True
End Sub

Open in new window

Sub Process3()
    ' some code
    Sheets("sheet1").ListBox1.Selected(2) = True
End Sub

Open in new window

Sub Process4()
    ' some code
    Sheets("sheet1").ListBox1.Selected(3) = True
End Sub

Open in new window

The above four can obviously be done one at a time and to do all at once you would do
Private Sub CMD_RUNALL_Click()
    Process1
    Process2
    Process3
    Process4
End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
Code execution proceeds line by line unless interrupted by an error.
To expand on that a bit, given these two subs where Sub1 is executed

Sub Sub1()
Line 1
Line 2
Sub2
Line 3
Line 4
End Sub

Open in new window

Sub Sub2()
Line A
Line B
End sub

Open in new window


the code would run in this order
Line 1
Line 2
Line A
Line B
Line 3
Line 4
0
 
Martin LissOlder than dirtCommented:
Try this which shows the progress using a progress bar.
PB.xls
0
 
John SheehySecurity AnalystAuthor Commented:
Martin, Love the progress bar.  

A few questions:
The module you have running to show the progress bar is performActions  Which is easy enough to change on my Run All button.  When it comes to the arrTasks(0) = Exporting CNE" and so on do I insert the following:

arrTasks(0) = "Exporting CNE"
Call CMD_RUN_CNE_Click

arrTask(1) = Exporting LHC"
Call CMD_RUN_LHC_Click

and so on so it actually runs the portion of code I need ran?

Thanks
John
0
 
Martin LissOlder than dirtCommented:
I made some changes so that the description of what was being worked on did not have to match the name of the process being worked on. I also added some hopefully helpful comments.
PB.xls
0
 
John SheehySecurity AnalystAuthor Commented:
Martin,

Sorry it took so long to get back on.  Been a crazy week.  But your solution worked for me.
Thank you.

John
0
 
John SheehySecurity AnalystAuthor Commented:
Martins Patience and on point solution helped out greatly.

John
0
 
Martin LissOlder than dirtCommented:
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014
0

Featured Post

Receive 1:1 tech help

Solve your biggest tech problems alongside global tech experts with 1:1 help.

  • 10
  • 6
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now