Hi community.
I wonder if anybody would be willing to have a quick look at my code below
and offer me any suggestions for fine tuning/making faster?
What you need to know:
I have a userform which has two listboxes, the listbox values are:
listbox1) values derived from oSourceDoc table rows, (oSourceDoc has a
fourcolumn table with many rows I call entries)
listbox2) values derived from name of all open documents in a particular
network folder (U:\checkout).
The code below does work, what it is designed to do is read which listitems
the user has selected from listbox1, copy the relevant table rows from
oSourceDoc and then paste them into the documents selected in listbox2.
My goal would be to make this a faster process if possible, it's currently
taking about 1 second to copy 1 row into two documents.
Full code below (for this part of the project), btw, please don't snigger at
my efforts as I'm still learning lol :)
===================================================
Public Function CopyRecords()
Dim oRow As Row
frmCopyProgress.Show
On Error GoTo ErrHandler
'stop screenupdates
Application.ScreenUpdating = False
'this is the selection for the rows of the source doc
For x = 0 To lbxEntries.ListCount - 1
If lbxEntries.Selected(x) = True Then
y = x + 2
With oSourceDoc.Tables(2).Rows(y)
Set myRange = .Cells(1).Range
myRange.End = .Cells(4).Range.End
'myRange.End = .Cells(.Cells.Count).Range.End
End With
myRange.Font.Name = "Arial"
myRange.Copy
'this loops through which target docs the user wants to paste in
'then pastes the row at the end
For z = 0 To lbxTargetDocs.ListCount - 1
If lbxTargetDocs.Selected(z) = True Then
k = z + 1
If Application.Documents(k).Name <> oSourceDoc.Name Then
Select Case Application.Documents(k).Tables.Count
Case 1: ' for old style runners
With Application.Documents(k).Tables(1)
.Rows.Last.Select
Selection.InsertRowsAbove
Selection.Paste
End With
Case 2 ' for new style runners
With Application.Documents(k).Tables(2)
If .Rows.Count = 1 Then
.Rows.Add
.Rows.Last.HeightRule = wdRowHeightAtLeast
.Rows.Last.Height = 20
.Rows.Last.Select
Selection.Font.Name = "Arial"
Else
.Rows.Add
.Rows.Last.Select
End If
Selection.Paste
End With
Case Else
j = Application.Documents(k).Tables.Count
Application.Documents(k).Tables(j).Rows.Last.Select
Selection.Paste
End Select
End If
End If
UpdateCopyProgressBar y
Next z
End If
Next x
Selection.Collapse
If chkSort.Value = True Then
DateSort k
End If
If chkDelete.Value = True Then
DeleteBlankRows k
End If
Set myRange = Nothing
Unload frmCopyProgress
Unload frmCopyRecord
MsgBox "Records copied sucessfully!", vbInformation, "Complete"
ErrHandler:
If Err.Number = 5941 Then
MsgBox "No Running Record table in the target document, please call
the Castle Helpdesk, click OK for more information", vbCritical, "Error 5941"
frmHelp.Show
Exit Function
End If
End Function
===================================================
Any advice and assitance offered will be most gratefully received.
Thanks for your time.
|
|
0
|
|
|
|
Reply
|
 Utf
|
2/16/2010 11:27:01 AM |
|
1. why are you this as a Function, rather than a Sub?
2. WHERE is this function? As in what code module?
3. The procedure calls the .Show of the userform.
frmCopyProgress.Show
On Error GoTo ErrHandler
'stop screenupdates
Application.ScreenUpdating = False
'this is the selection for the rows of the source doc
For x = 0 To lbxEntries.ListCount - 1
If lbxEntries.Selected(x) = True Then
.......
Therefore the focus is shifted TO the userform. What in the userform code
module returns focus back to this procedure? I would think that is a slow-
down itself. For example:
Sub ShowMe()
UserForm1.Show
MsgBox "Done."
End Sub
Once userform1.show executes NOTHING happens after (in this procedure) until
focus is passed back to it.
4. You seem to using a progress bar: UpdateCopyProgressBar y
This also is going to slow things down, although it should not be by much.
However, depending on how much you are jumping back and forth between
procedures, it may.
spunkymuffmonkey wrote:
>Hi community.
>
>I wonder if anybody would be willing to have a quick look at my code below
>and offer me any suggestions for fine tuning/making faster?
>
>What you need to know:
>
>I have a userform which has two listboxes, the listbox values are:
>
>listbox1) values derived from oSourceDoc table rows, (oSourceDoc has a
>fourcolumn table with many rows I call entries)
>
>listbox2) values derived from name of all open documents in a particular
>network folder (U:\checkout).
>
>The code below does work, what it is designed to do is read which listitems
>the user has selected from listbox1, copy the relevant table rows from
>oSourceDoc and then paste them into the documents selected in listbox2.
>
>My goal would be to make this a faster process if possible, it's currently
>taking about 1 second to copy 1 row into two documents.
>
>Full code below (for this part of the project), btw, please don't snigger at
>my efforts as I'm still learning lol :)
>
>===================================================
>
>Public Function CopyRecords()
>Dim oRow As Row
>
>frmCopyProgress.Show
>On Error GoTo ErrHandler
>'stop screenupdates
>Application.ScreenUpdating = False
>
>'this is the selection for the rows of the source doc
>For x = 0 To lbxEntries.ListCount - 1
> If lbxEntries.Selected(x) = True Then
> y = x + 2
> With oSourceDoc.Tables(2).Rows(y)
> Set myRange = .Cells(1).Range
> myRange.End = .Cells(4).Range.End
> 'myRange.End = .Cells(.Cells.Count).Range.End
> End With
> myRange.Font.Name = "Arial"
> myRange.Copy
>
>'this loops through which target docs the user wants to paste in
> 'then pastes the row at the end
> For z = 0 To lbxTargetDocs.ListCount - 1
> If lbxTargetDocs.Selected(z) = True Then
> k = z + 1
> If Application.Documents(k).Name <> oSourceDoc.Name Then
> Select Case Application.Documents(k).Tables.Count
> Case 1: ' for old style runners
> With Application.Documents(k).Tables(1)
> .Rows.Last.Select
> Selection.InsertRowsAbove
> Selection.Paste
> End With
>
> Case 2 ' for new style runners
> With Application.Documents(k).Tables(2)
> If .Rows.Count = 1 Then
> .Rows.Add
> .Rows.Last.HeightRule = wdRowHeightAtLeast
> .Rows.Last.Height = 20
> .Rows.Last.Select
> Selection.Font.Name = "Arial"
> Else
> .Rows.Add
> .Rows.Last.Select
> End If
> Selection.Paste
> End With
>
> Case Else
> j = Application.Documents(k).Tables.Count
> Application.Documents(k).Tables(j).Rows.Last.Select
> Selection.Paste
>
> End Select
> End If
> End If
> UpdateCopyProgressBar y
> Next z
> End If
>Next x
>
>Selection.Collapse
>
>If chkSort.Value = True Then
> DateSort k
>End If
>If chkDelete.Value = True Then
> DeleteBlankRows k
>End If
>
>Set myRange = Nothing
>
>Unload frmCopyProgress
>Unload frmCopyRecord
>MsgBox "Records copied sucessfully!", vbInformation, "Complete"
>
>ErrHandler:
> If Err.Number = 5941 Then
> MsgBox "No Running Record table in the target document, please call
>the Castle Helpdesk, click OK for more information", vbCritical, "Error 5941"
> frmHelp.Show
> Exit Function
> End If
>
>End Function
>
>===================================================
>
>Any advice and assitance offered will be most gratefully received.
>
>Thanks for your time.
--
Message posted via http://www.officekb.com
|
|
|
0
|
|
|
|
Reply
|
Fumei2
|
2/16/2010 7:53:37 PM
|
|
Hi Fumei2,
Many thanks for your time and reply, firstly to answer your questions:
1) Because I don't know any better, I'm still learning how/where to use
functions and tend to find myself writing 'public function' instead of
thinking about what I'm doing!
2) This function is sat in a userform module code, the whole code module (I
thought) was too large and would put people off from reading and helping me!
3) Once the frmCopyProgress form is show I have nothing that returns focus
to the my main calling function, the progress userform modal property is
false.
4) I am indeed jumping back and forth between my main routine and a routine
that updates the progress userform, although I would like to display
something whilst this macro is working, a progress form is not an essential,
is there any advice surrounding keeping people aware of what the computer is
doing?
I shall take on board your comments and thank you for your kind assistance,
any further help and advice will be greatly received.
Many thanks
"Fumei2 via OfficeKB.com" wrote:
> 1. why are you this as a Function, rather than a Sub?
>
> 2. WHERE is this function? As in what code module?
>
> 3. The procedure calls the .Show of the userform.
>
> frmCopyProgress.Show
> On Error GoTo ErrHandler
> 'stop screenupdates
> Application.ScreenUpdating = False
>
> 'this is the selection for the rows of the source doc
> For x = 0 To lbxEntries.ListCount - 1
> If lbxEntries.Selected(x) = True Then
>
> .......
>
> Therefore the focus is shifted TO the userform. What in the userform code
> module returns focus back to this procedure? I would think that is a slow-
> down itself. For example:
>
> Sub ShowMe()
> UserForm1.Show
> MsgBox "Done."
> End Sub
>
> Once userform1.show executes NOTHING happens after (in this procedure) until
> focus is passed back to it.
>
>
> 4. You seem to using a progress bar: UpdateCopyProgressBar y
>
> This also is going to slow things down, although it should not be by much.
> However, depending on how much you are jumping back and forth between
> procedures, it may.
>
> spunkymuffmonkey wrote:
> >Hi community.
> >
> >I wonder if anybody would be willing to have a quick look at my code below
> >and offer me any suggestions for fine tuning/making faster?
> >
> >What you need to know:
> >
> >I have a userform which has two listboxes, the listbox values are:
> >
> >listbox1) values derived from oSourceDoc table rows, (oSourceDoc has a
> >fourcolumn table with many rows I call entries)
> >
> >listbox2) values derived from name of all open documents in a particular
> >network folder (U:\checkout).
> >
> >The code below does work, what it is designed to do is read which listitems
> >the user has selected from listbox1, copy the relevant table rows from
> >oSourceDoc and then paste them into the documents selected in listbox2.
> >
> >My goal would be to make this a faster process if possible, it's currently
> >taking about 1 second to copy 1 row into two documents.
> >
> >Full code below (for this part of the project), btw, please don't snigger at
> >my efforts as I'm still learning lol :)
> >
> >===================================================
> >
> >Public Function CopyRecords()
> >Dim oRow As Row
> >
> >frmCopyProgress.Show
> >On Error GoTo ErrHandler
> >'stop screenupdates
> >Application.ScreenUpdating = False
> >
> >'this is the selection for the rows of the source doc
> >For x = 0 To lbxEntries.ListCount - 1
> > If lbxEntries.Selected(x) = True Then
> > y = x + 2
> > With oSourceDoc.Tables(2).Rows(y)
> > Set myRange = .Cells(1).Range
> > myRange.End = .Cells(4).Range.End
> > 'myRange.End = .Cells(.Cells.Count).Range.End
> > End With
> > myRange.Font.Name = "Arial"
> > myRange.Copy
> >
> >'this loops through which target docs the user wants to paste in
> > 'then pastes the row at the end
> > For z = 0 To lbxTargetDocs.ListCount - 1
> > If lbxTargetDocs.Selected(z) = True Then
> > k = z + 1
> > If Application.Documents(k).Name <> oSourceDoc.Name Then
> > Select Case Application.Documents(k).Tables.Count
> > Case 1: ' for old style runners
> > With Application.Documents(k).Tables(1)
> > .Rows.Last.Select
> > Selection.InsertRowsAbove
> > Selection.Paste
> > End With
> >
> > Case 2 ' for new style runners
> > With Application.Documents(k).Tables(2)
> > If .Rows.Count = 1 Then
> > .Rows.Add
> > .Rows.Last.HeightRule = wdRowHeightAtLeast
> > .Rows.Last.Height = 20
> > .Rows.Last.Select
> > Selection.Font.Name = "Arial"
> > Else
> > .Rows.Add
> > .Rows.Last.Select
> > End If
> > Selection.Paste
> > End With
> >
> > Case Else
> > j = Application.Documents(k).Tables.Count
> > Application.Documents(k).Tables(j).Rows.Last.Select
> > Selection.Paste
> >
> > End Select
> > End If
> > End If
> > UpdateCopyProgressBar y
> > Next z
> > End If
> >Next x
> >
> >Selection.Collapse
> >
> >If chkSort.Value = True Then
> > DateSort k
> >End If
> >If chkDelete.Value = True Then
> > DeleteBlankRows k
> >End If
> >
> >Set myRange = Nothing
> >
> >Unload frmCopyProgress
> >Unload frmCopyRecord
> >MsgBox "Records copied sucessfully!", vbInformation, "Complete"
> >
> >ErrHandler:
> > If Err.Number = 5941 Then
> > MsgBox "No Running Record table in the target document, please call
> >the Castle Helpdesk, click OK for more information", vbCritical, "Error 5941"
> > frmHelp.Show
> > Exit Function
> > End If
> >
> >End Function
> >
> >===================================================
> >
> >Any advice and assitance offered will be most gratefully received.
> >
> >Thanks for your time.
>
> --
> Message posted via http://www.officekb.com
>
> .
>
|
|
|
0
|
|
|
|
Reply
|
Utf
|
2/17/2010 9:55:01 AM
|
|
|
2 Replies
361 Views
(page loaded in 0.084 seconds)
|
Search |
Post Question |
Groups |
Stream |
About |
Register
1023 articles. 
5 followers. 