Solved

Updating the status in a listbox

Posted on 2014-12-01
18
58 Views
Last Modified: 2014-12-15
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
Comment
Question by:John Sheehy
  • 10
  • 6
  • 2
18 Comments
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
Comment Utility
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
 

Author Comment

by:John Sheehy
Comment Utility
Can I use that in Excel?
0
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
How about something as simple as this?
Q-28572481.xlsm
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
Comment Utility
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
 

Author Comment

by:John Sheehy
Comment Utility
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
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

Author Comment

by:John Sheehy
Comment Utility
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
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
Try this which shows the progress using a progress bar.
PB.xls
0
 

Author Comment

by:John Sheehy
Comment Utility
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
 
LVL 45

Accepted Solution

by:
Martin Liss earned 500 total points
Comment Utility
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
 

Author Comment

by:John Sheehy
Comment Utility
Martin,

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

John
0
 

Author Closing Comment

by:John Sheehy
Comment Utility
Martins Patience and on point solution helped out greatly.

John
0
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now