Excel VBA inconsistent errors when trying to copy and paste objects from Excel to Word

[bisel]

Hello All,

I have some VBA code that will sometimes run just fine and sometimes will give an error. I am getting very frustrated and in need of some help ... I have tried various things, but just cannot find a solution.

First ... what I am trying to do ...

I have an embedded Word document with various bookmarks. These bookmarks corespondent to named ranges in the Excel workbook. My VBA code:

• Opens the embedded Word document
• Makes a copy of the document and then closes the embedded document to preserve its contents
• Within a loop in the VBA code, copies the various named ranges in the Excel workbook and pastes the content of the clipboard at the appropriate bookmark in the Word document. Also, depending on what I am trying to do it will paste as picture or table.

Here is the VBA code ...

Sub create_diy_report_latebinding()


Dim wdApp As Object
Dim wdDoc As Object
Dim newWord As Object
Dim oleObj As Object
Dim pasteobject As Range
Dim diy_excel_range As String
Dim diy_word_bm As String
Dim diy_excel_content As String
Dim diy_word_content As String
Dim diy_vba_case As Integer
Dim diy_sheet_num As Worksheet
Dim ws As Worksheet
Dim detailnum As String
Dim shownum As String
Dim i As Integer
Dim bmrange As String
Dim mytable As Object
Dim headertext As String
Dim errorcount As Integer




Application.ScreenUpdating = False


On Error GoTo errorhandler
errorcount = 0 ' Set errorcount to zero


Application.DisplayAlerts = False


Set oleObj = Sheet5.OLEObjects("diy_template")
oleObj.Verb Verb:=xlPrimary
oleObj.Activate


Application.DisplayAlerts = True


Set wdApp = oleObj.Object.Application


With wdApp
    .Visible = True
    .Activate
    Set wdDoc = wdApp.Documents(1) ' wdDoc will be the embedded Word doc
    .Documents.Add ' add a new document
    Set newWord = wdApp.Documents(1) ' newWord will be the new blank document
End With


'Select and copy all content from DIY Template to the new Word document
    wdDoc.Content.Copy ' copy contents from the diy template
    newWord.Content.Paste ' paste contents into the new document


' Close the DIY Template to prevent changing it and then activate the new Word doc
    wdDoc.Close (wdDoNotSaveChanges)
    newWord.Activate
'
' Perform edits on the new Word document by copying and pasting content from RFA
With newWord
    For Each c In Sheet5.Range("diy_report_bmnum") 'All values from table in Data Validation sheet
        diy_excel_range = c.Offset(0, 1).Value
        diy_word_bm = c.Offset(0, 2).Value
        diy_excel_content = c.Offset(0, 4).Value
        diy_word_content = c.Offset(0, 5).Value
        diy_vba_case = c.Offset(0, 6).Value


        Select Case diy_vba_case


            Case 1 'Copy range and paste as text replace bookmark text with text from Excel range
'                .Bookmarks(diy_word_bm).Range.InsertAfter (Range(diy_excel_range).Value) 'Copies single cell value after word bookmark
                .Bookmarks(diy_word_bm).Range.Text = Range(diy_excel_range).Value 'Copies single cell value to replace word bookmark text


            Case 2 'Copy range or table as picture and paste as picture
                Range(diy_excel_range).CopyPicture
                .Bookmarks(diy_word_bm).Range.Characters.Last.Paste


            Case 3 'Copy chart from Sheet10 and paste as picture
                Sheet10.ChartObjects(diy_excel_range).Activate
                Sheet10.ChartObjects(diy_excel_range).Copy 'Copies chart from Excel and pastes as picture in Word
                .Bookmarks(diy_word_bm).Range.PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, DisplayAsIcon:=False


            Case 4 'Copy chart from Sheet7 and paste as picture
                Sheet7.ChartObjects(diy_excel_range).Activate
                Sheet7.ChartObjects(diy_excel_range).Copy 'Copies chart from Excel and pastes as picture in Word
                .Bookmarks(diy_word_bm).Range.PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, DisplayAsIcon:=False


            Case 5 'Copy chart from Sheet4 and paste as picture
                Sheet4.ChartObjects(diy_excel_range).Activate
                Sheet4.ChartObjects(diy_excel_range).Copy 'Copies chart from Excel and pastes as picture in Word
                .Bookmarks(diy_word_bm).Range.PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, DisplayAsIcon:=False


            Case 6 'Copy range or table and paste as table
                Range(diy_excel_range).Copy ' copy range of cells as table from Excel
                .Bookmarks(diy_word_bm).Range.Characters.Last.Paste ' paste to Word
                .Tables(.Tables.Count).Rows.AllowBreakAcrossPages = False
                .Tables(.Tables.Count).Shading.BackgroundPatternColor = wdColorAutomatic
                .Tables(.Tables.Count).Borders.InsideLineStyle = wdLineStyleNone
                .Tables(.Tables.Count).Borders.OutsideLineStyle = wdLineStyleNone


            Case Else
        End Select
        
            ' insert delay to ensure that all actions complete before going to next case
            '    Application.Wait (Now() + TimeValue("0:00:1"))
        
        
        
    Next c




    ' copy all component details as picture and paste into word


        For i = 250 To 1 Step -1 ' For each component item from 1 to 250, do in reverse order


            Application.CutCopyMode = False 'clear clipboard
            detailnum = "detail" & i
            shownum = "show" & i


            ' Check if the item is included in the component list, if not skip
            If Range(shownum).Value = 1 Then
                Range(detailnum).CopyPicture ' copy range as picture from Excel
                .Bookmarks("comp_details_bookmark").Range.Characters.Last.Paste
                Application.CutCopyMode = False 'clear clipboard
            Else
            End If


        Next i


End With 'End with newWord doc


' Update all fields in the document
    newWord.TablesOfContents(1).Update
    newWord.TablesOfFigures(1).Update
    newWord.TablesOfFigures(2).Update
    newWord.Fields.Update




' Format tables except the "Terms and Def" table
    For Each mytable In newWord.Tables
        If mytable.Title <> "terms" Then
            mytable.Range.Font.Size = 9
            mytable.Rows(1).HeadingFormat = True 'Set first row as table header
            mytable.Rows(2).HeadingFormat = True 'Set second row as table header
            mytable.Rows.AllowBreakAcrossPages = False ' prevent rows breaking across pages
        Else
            mytable.Shading.ForegroundPatternColor = -16777216 ' Set "terms" table for automatic color prevent different shading
            mytable.Shading.BackgroundPatternColor = -16777216 ' Set "terms" table for automatic color prevent different shading
        End If
    Next




On Error GoTo dispmsg


newWord.sections(2).headers(1).Range.Text = Sheet5.Range("diy_header").Value
newWord.sections(2).headers(1).Range.Paragraphs.Alignment = 2 ' Right justify header




Set wdApp = Nothing
Set wdDoc = Nothing


Sheet16.Select


dispmsg:


Select Case errorcount
    Case Is = 0
        MsgBox "Reserve Study Report Complete", vbInformation + vbOKOnly, "Reserve Study Report"


    Case Is > 0 'display message about an error was found
        MsgBox "Reserve Study Report Created.  A total of " & errorcount & " error(s) encountered during report creation.  " & vbNewLine & vbNewLine & _
        "The errors or likely minor.  Try closing the Word document without saving.  Then run this routine again." & vbNewLine & vbNewLine & _
        "If error(s) persist, review the report for potential omissions of data such as tables and charts.  " & _
        "You may have to perform manual edits and changes.", vbCritical + vbOKOnly, "Reserve Study Report Errors"
    End Select


Exit Sub


errorhandler:


MsgBox (diy_word_bm)


    errorcount = errorcount + 1
    Resume Next


End Sub

If you examine the code, you will see starting with the statement, "With newWord", that I am reading a table in the Excel workbook to obtain the named range and the bookmark. Here is that table ...

[TABLE="class: grid, width: 1090"]
<colgroup><col><col><col><col><col span="2"><col><col></colgroup><tbody>[TR]
[TD]Bookmark[/TD]
[TD]Excel Range[/TD]
[TD]Word Bookmark[/TD]
[TD]Description[/TD]
[TD]Excel Content[/TD]
[TD]Word Content[/TD]
[TD]VBA Case[/TD]
[TD]Excel Sheet Num[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]hoaname[/TD]
[TD]hoaname[/TD]
[TD]HOA Name[/TD]
[TD]range[/TD]
[TD]text[/TD]
[TD]1[/TD]
[TD]Sheet19[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]hoa_city_state[/TD]
[TD]hoa_city_state[/TD]
[TD]HOA City and State[/TD]
[TD]range[/TD]
[TD]text[/TD]
[TD]1[/TD]
[TD]Sheet19[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]currentyear[/TD]
[TD]currentyear[/TD]
[TD]Current Year of Analysis[/TD]
[TD]range[/TD]
[TD]text[/TD]
[TD]1[/TD]
[TD]Sheet19[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]todays_date[/TD]
[TD]report_date[/TD]
[TD]Today's Date[/TD]
[TD]range[/TD]
[TD]text[/TD]
[TD]1[/TD]
[TD]Sheet5[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]cummunity_profile[/TD]
[TD]cummunity_profile[/TD]
[TD]Community Profile & Account Summary[/TD]
[TD]table[/TD]
[TD]picture[/TD]
[TD]2[/TD]
[TD]Sheet10[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]current_pctfunding_barchart[/TD]
[TD]current_pctfunding_barchart[/TD]
[TD]Current Pct Funding Horizontal Chart[/TD]
[TD]chart[/TD]
[TD]picture[/TD]
[TD]3[/TD]
[TD]Sheet10[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]reserve_study_parameters[/TD]
[TD]reserve_study_parameters[/TD]
[TD]Reserve Study Parameters[/TD]
[TD]table[/TD]
[TD]picture[/TD]
[TD]2[/TD]
[TD]Sheet10[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]current_income_sources[/TD]
[TD]current_income_sources[/TD]
[TD] [/TD]
[TD]table[/TD]
[TD]picture[/TD]
[TD]2[/TD]
[TD]Sheet10[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]current_expenses[/TD]
[TD]current_expenses[/TD]
[TD] [/TD]
[TD]table[/TD]
[TD]picture[/TD]
[TD]2[/TD]
[TD]Sheet10[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]future_income_sources[/TD]
[TD]future_income_sources[/TD]
[TD] [/TD]
[TD]table[/TD]
[TD]picture[/TD]
[TD]2[/TD]
[TD]Sheet10[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]res_comp_summary_table[/TD]
[TD]res_comp_summary_table[/TD]
[TD]Reserve Component Inventory Tables[/TD]
[TD]table[/TD]
[TD]table[/TD]
[TD]6[/TD]
[TD]Sheet3[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]allocation_bycategory_smallchart[/TD]
[TD]allocation_bycategory_chart[/TD]
[TD]Column chart of Reserve Fund by Category[/TD]
[TD]chart[/TD]
[TD]picture[/TD]
[TD]5[/TD]
[TD]Sheet4[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]income_and_expense_summary[/TD]
[TD]income_and_expense_summary[/TD]
[TD]Income and Expense Summary[/TD]
[TD]range[/TD]
[TD]picture[/TD]
[TD]2[/TD]
[TD]Sheet18[/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD]annual_res_expenditures_chart[/TD]
[TD]annual_res_expenditures_chart[/TD]
[TD] [/TD]
[TD]chart[/TD]
[TD]picture[/TD]
[TD]4[/TD]
[TD]Sheet7[/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD]all_annual_expenses_chart[/TD]
[TD]all_annual_expenses_chart[/TD]
[TD] [/TD]
[TD]chart[/TD]
[TD]picture[/TD]
[TD]4[/TD]
[TD]Sheet7[/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD]pctfund_chart[/TD]
[TD]pctfund_chart[/TD]
[TD] [/TD]
[TD]chart[/TD]
[TD]picture[/TD]
[TD]4[/TD]
[TD]Sheet7[/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]annual_res_contrib_chart[/TD]
[TD]annual_res_contrib_chart[/TD]
[TD] [/TD]
[TD]chart[/TD]
[TD]picture[/TD]
[TD]4[/TD]
[TD]Sheet7[/TD]
[/TR]
[TR]
[TD]18[/TD]
[TD]startyear_reserve_expenses_chart[/TD]
[TD]startyear_reserve_expenses_chart[/TD]
[TD] [/TD]
[TD]chart[/TD]
[TD]picture[/TD]
[TD]4[/TD]
[TD]Sheet7[/TD]
[/TR]
[TR]
[TD]19[/TD]
[TD]reserve_balance_compare_chart[/TD]
[TD]reserve_balance_compare_chart[/TD]
[TD] [/TD]
[TD]chart[/TD]
[TD]picture[/TD]
[TD]4[/TD]
[TD]Sheet7[/TD]
[/TR]
[TR]
[TD]20[/TD]
[TD]pct_funded_compare_chart[/TD]
[TD]pct_funded_compare_chart[/TD]
[TD] [/TD]
[TD]chart[/TD]
[TD]picture[/TD]
[TD]4[/TD]
[TD]Sheet7[/TD]
[/TR]
[TR]
[TD]21[/TD]
[TD]spec_assess_risk_chart[/TD]
[TD]spec_assess_risk_chart[/TD]
[TD] [/TD]
[TD]chart[/TD]
[TD]picture[/TD]
[TD]4[/TD]
[TD]Sheet7[/TD]
[/TR]
[TR]
[TD]22[/TD]
[TD]contingency_fund_summary[/TD]
[TD]contingency_fund_summary[/TD]
[TD] [/TD]
[TD]table[/TD]
[TD]picture[/TD]
[TD]2[/TD]
[TD]Sheet10[/TD]
[/TR]
[TR]
[TD]23[/TD]
[TD]eoy_contingency_chart[/TD]
[TD]eoy_contingency_chart[/TD]
[TD] [/TD]
[TD]chart[/TD]
[TD]picture[/TD]
[TD]4[/TD]
[TD]Sheet7[/TD]
[/TR]
[TR]
[TD]24[/TD]
[TD]diyheading_yrs1[/TD]
[TD]diyheading_yrs1[/TD]
[TD]Heading text for DIY report[/TD]
[TD]range[/TD]
[TD]text[/TD]
[TD]1[/TD]
[TD]Sheet5[/TD]
[/TR]
[TR]
[TD]25[/TD]
[TD]income_expense_summary1[/TD]
[TD]income_expense_summary1[/TD]
[TD]income expense summ yr 1-10[/TD]
[TD]range[/TD]
[TD]picture[/TD]
[TD]2[/TD]
[TD]Sheet13[/TD]
[/TR]
[TR]
[TD]26[/TD]
[TD]sheet13table2[/TD]
[TD]sheet13table2[/TD]
[TD]Reserve expenses yrs 1-10[/TD]
[TD]table[/TD]
[TD]table[/TD]
[TD]6[/TD]
[TD]Sheet13[/TD]
[/TR]
[TR]
[TD]27[/TD]
[TD]diyheading_yrs2[/TD]
[TD]diyheading_yrs2[/TD]
[TD]Heading text for DIY report[/TD]
[TD]range[/TD]
[TD]text[/TD]
[TD]1[/TD]
[TD]Sheet5[/TD]
[/TR]
[TR]
[TD]28[/TD]
[TD]income_expense_summary2[/TD]
[TD]income_expense_summary2[/TD]
[TD]income expense summ yr 11-20[/TD]
[TD]range[/TD]
[TD]picture[/TD]
[TD]2[/TD]
[TD]Sheet13[/TD]
[/TR]
[TR]
[TD]29[/TD]
[TD]sheet13table6[/TD]
[TD]sheet13table6[/TD]
[TD]Reserve expenses yrs 11-20[/TD]
[TD]table[/TD]
[TD]table[/TD]
[TD]6[/TD]
[TD]Sheet13[/TD]
[/TR]
[TR]
[TD]30[/TD]
[TD]diyheading_yrs3[/TD]
[TD]diyheading_yrs3[/TD]
[TD]Heading text for DIY report[/TD]
[TD]range[/TD]
[TD]text[/TD]
[TD]1[/TD]
[TD]Sheet5[/TD]
[/TR]
[TR]
[TD]31[/TD]
[TD]income_expense_summary3[/TD]
[TD]income_expense_summary3[/TD]
[TD]income expense summ yr 21-30[/TD]
[TD]range[/TD]
[TD]picture[/TD]
[TD]2[/TD]
[TD]Sheet13[/TD]
[/TR]
[TR]
[TD]32[/TD]
[TD]sheet13table10[/TD]
[TD]sheet13table10[/TD]
[TD]Reserve expenses yrs 21-30[/TD]
[TD]table[/TD]
[TD]table[/TD]
[TD]6[/TD]
[TD]Sheet13[/TD]
[/TR]
[TR]
[TD]33[/TD]
[TD]detail1 to detail 250[/TD]
[TD]comp_details_bookmark[/TD]
[TD]Individual detail tables[/TD]
[TD]range[/TD]
[TD]picture[/TD]
[TD]0[/TD]
[TD]Sheet6[/TD]
[/TR]
</tbody>[/TABLE]

Here is the issue I am having.

Sometimes when I execute the VBA, it gives me an error. It fails at inconsistent places. For example it might fail when attempting to copy/paste the named range, "income_expense_summary1". Or maybe at a different range/bookmark.

Other times, it will run without error and everything is as I wished it be.

I would so like it if someone can see what I am doing wrong ... cuz I am banging my head into wall trying to figure this out.

Thanks

Steve B.

 

[NdNoviceHlp]

Hi Steve B. Inconsistent and unexplained errors when using copy/paste usually means that your clipboard is crashing. U need to add some API code at the top of a module....

#If VBA7 Then
    Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Public Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
#Else 
    Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Public Declare Function CloseClipboard Lib "user32" () As Long
    Public Declare Function EmptyClipboard Lib "user32" () As Long
#End  If

To operate...

Application.CutCopyMode = False
 OpenClipboard (0&)
 EmptyClipboard
 CloseClipboard

HTH. Dave

 

[bisel]

Hi Dave,

I tried your suggestion, but it did not make any difference. But, I did find something that seems to work.

I found reference that others were experiencing similar problems and as they stated, it almost seems that the VBA is executing faster than the copy from Excel and paste to Word can keep up. Sometimes getting to a point where in trying to paste something, there isn't anything in the clipboard to paste.

The solution was to insert a "DoEvents" after the copy and before the paste and a DoEvent after the paste before moving on to the next copy operation. So far, that seems to be working.

Steve

 

[NdNoviceHlp]

Well that is interesting Steve. Thanks for posting your outcome. I'm glad U got it sorted out. Dave

 

[bisel]

I spoke too soon. Still getting intermittent errors when I run the VBA. Tried all your suggestions. Tried inserting DoEvents before and after the copy and the paste functions. Errors are unpredictable and they do not always occur with the same object or range that I am trying to copy and then paste. But, they always do occur with the paste function. When the error occurs, the error code is 1004 associated with the paste function.

Steve

 

[Jon Peltier]

In my experience, DoEvents takes care of most of this problem. Application.Wait doesn't help, because it prevents anything from actually catching up.

Better than Wait might be:

Dim t As Double
t = Timer
Do Until Timer - t > 1
  DoEvents
Loop

I've found that if I encapsulate the copy and paste operations into functions, and the main code calls the functions to perform these operations. entering and leaving a function seems to make VBA wait until operations within that function have completed.

For example, this simplified function pastes a chart into Word. The object passed into the function, oWdRng is the Word range where the chart will be pasted, which could be a bookmark but in this case is a regular range 0 characters wide; the object returned by the function is also a Word range 0 characters wide, positioned at the end of the chart, which pasted inline is one character wide.

Function PasteChartInWord(oWdRng As Object) As Object

  DoEvents
  oWdRng.PasteSpecial DataType:=WordPasteFormat(wdChtFormat), Placement:=0  ' 0 = wdInLine

  oWdRng.Collapse 0  ' 0 = wdCollapseEnd
  Set PasteChartInWord = oWdRng

End Function

This procedure is called like this:

  MyChart.ChartArea.Copy
  DoEvents
  Set oWdRng2 = PasteChartInWord(oWdRng)

Also note that I don't activate the chart before copying it.

 

[NdNoviceHlp]

Thanks Jon for sharing your experience. I hope that bisel gained as much learning as I did. Your information about using a timer instead of wait actually resolved my ongoing issues with phantom listbox selections posted here...
https://www.mrexcel.com/forum/excel...ntom-listbox-selection.html?highlight=listbox
Replacing wait with the timer routine completely resolved the issues I was having (that seemed resolved but were continuing to episodically occur). Thanks for that. Your insight into separating the copy and paste routines is also something that I have accidently stumbled into implementing apparently because it works. Now I have an understanding of why. Again thanks for your insights. Dave

 

[bisel]

An update on the issue I am having ...

I tried all the suggestions. I created a function and that did not resolve the issue. Instead of a function, a tried it as subroutine that I call from the main sub. Still have the problem. I inserted DoEvents in the code, but that did not make a difference. I put in the timer routine which pauses execution for 1 second. That seems at first blush to help, but I still get those inconsistent errors when copying a range or chart from Excel and paste it into Word. And the errors are indeed inconsistent ... that is, the error(s) are not always the same range or chart and in many instances, if I close the Word document without saving and run the VBA sub again, in many cases it runs to completion without errors.

Just banging my head on the wall trying to find a way to get around this. I am assuming that the error can be one of several things, but it appears that timing is the key issue. I am going to try to insert some additional timer routines into a few steps in the VBA and see if this helps.

Steve

 

[bisel]

I have stumbled across this method for pausing execution for less than one second ... trying this out inside the VBA code to see if can find a balance to timing issues without extending execution of the VBA too long.

Using the VBA code making use of Timer ... e.g., if you code this ...

t = Timer
Do Until Timer - t > 1
Loop

You set a timer to pause the VBA for one second. Problem is if you want to pause for less than one second or a fractional part of second. The Timer routine can only resolve for increments of one second.

However, using the Windows API function, Sleep, one can be more granular and specify a time period in milliseconds. Sleep is not part of VBA, but can be accessed by using a special declaration statement in the VBA code. I placed the following lines of code as a public declaration statement at the beginning of the VBA module ...

[COLOR=#333333][FONT=Consolas][SIZE=3][FONT=arial][SIZE=2]#If VBA7 Then ' Excel 2010 or later
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]  ' Excel 2007 or earlier
    Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If[/SIZE]
[/FONT][/SIZE]
[/FONT][/COLOR]

With the public declaration statement (above), I then use the Windows Sleep API ...
"Sleep n" ... where n is a number in milliseconds.

So, to pause for 1 second, the syntax is Sleep 1000

This API does lock out the user until the sleep period has finished, but in my case, that is what I want to do. Using Ctrl+Break will interrupt the macro. BTW, the Sleep API is Windows only, not on a Mac.

Steve

 

[Jon Peltier]

Sub TestTime()
  Dim t As Double
  t = Timer
  Do Until Timer - t >= 0.5
    DoEvents
  Loop
  Debug.Print Timer - t
End Sub

The output in the Immediate Window is:

0.5

So you can in fact wait less than one second using Timer, without locking up everything the way Wait does. It's not terribly precise; if I change the Do command to

  Do Until Timer - t >= 0.1

The Immediate Window displays:

0.1015625