VBA help selecting excel rows with data and exporting to word

[crvazquez954]

Hi,

I have a spreadsheet I am preparing for my boss that requires me to review column B (B28:B47) on the "Summary" sheet, determine which rows have data and transfer a portion of the rows (columns B, C, D, E & F) to a word template called "Proposal". I have limited experience with VBA but I know I need a macro code in order to do this. Can anyone help me write an easy code that does this for me? I appreciate any help.

Thanks

 

[DanteAmor]

Check this out

https://www.mrexcel.com/forum/excel...document-based-data-entered-through-form.html

 

[crvazquez954]

Thanks for the guidance but the it doesn't really help with what I am trying to do. Below is a copy of the code I have so far. However, I would like to eliminate blank rows, merge with Word formatting and keep the document open for review. Any help or guidance you can provide would be greatly appreciated.

Sub Export_Table_Word()


'Name of the existing Word doc.
Const stWordReport As String = "Test.docm"

'Word objects.
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdbmRange As Word.Range

'Excel objects.
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnReport As Range

'Initialize the Excel objects.
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Summary")
Set rnReport = wsSheet.Range("BidTable")

'Initialize the Word objects.
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Open(wbBook.Path & "" & stWordReport)
Set wdbmRange = wdDoc.Bookmarks("InsertHere").Range

'If the macro has been run before, clean up any artifacts before trying to paste the table in again.
On Error Resume Next
With wdDoc.InlineShapes(1)
.Select
.Delete
End With
On Error GoTo 0

'Turn off screen updating.
Application.ScreenUpdating = False

'Copy the report to the clipboard.
rnReport.Copy

'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
With wdbmRange
.Select
.PasteSpecial Link:=False, _
DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, _
DisplayAsIcon:=False
End With

'Save and close the Word doc.
With wdDoc
.Save
.Close
End With

'Quit Word.
wdApp.Quit

'Null out your variables.
Set wdbmRange = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing

'Clear out the clipboard, and turn screen updating back on.
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

MsgBox "The report has successfully been " & vbNewLine & _
"transferred to " & stWordReport, vbInformation


End Sub

 

[DanteAmor]

Thanks for the guidance but the it doesn't really help with what I am trying to do. Below is a copy of the code I have so far. However, I would like to eliminate blank rows, merge with Word formatting and keep the document open for review. Any help or guidance you can provide would be greatly appreciated.

First you should hide the rows in excel, then copy and paste in word


To leave the word open, remove the following lines from the code

    'Save and close the Word doc.
    With wdDoc
        .Save
        .Close
    End With
    
    'Quit Word.
    wdApp.Quit
    
    'Null out your variables.
    Set wdbmRange = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing
    
    'Clear out the clipboard, and turn screen updating back on.
    With Application
    .CutCopyMode = False
    .ScreenUpdating = True
    End With

 

[crvazquez954]

Thanks for the help Dante. Putting together a macro that would remove or hide the blank rows before pasting to word is part of the problem I'm having. I'm also trying to figure out how to merge with the word formatting and keep Word open. I removed the code you suggested but it still saves and closes out the word doc.

 

[DanteAmor]

Thanks for the help Dante. Putting together a macro that would remove or hide the blank rows before pasting to word is part of the problem I'm having. I'm also trying to figure out how to merge with the word formatting and keep Word open. I removed the code you suggested but it still saves and closes out the word doc.

Try this

Sub Export_Table_Word()
    'Name of the existing Word doc.
    Const stWordReport As String = "Test.docm"
    
    'Word objects.
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdbmRange As Word.Range
    
    'Excel objects.
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim rnReport As Range
[COLOR=#0000ff]    Dim r As Range[/COLOR]
    
    'Initialize the Excel objects.
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("Summary")
    Set rnReport = wsSheet.Range("BidTable")
    
[COLOR=#0000ff]    For Each r In rnReport.Rows[/COLOR]
[COLOR=#0000ff]        If WorksheetFunction.CountA(r) = 0 Then r.Hidden = True[/COLOR]
[COLOR=#0000ff]    Next[/COLOR]
    
    'Initialize the Word objects.
    Set wdApp = New Word.Application
    Set wdDoc = wdApp.Documents.Open(wbBook.Path & "" & stWordReport)
    Set wdbmRange = wdDoc.Bookmarks("InsertHere").Range
[COLOR=#0000ff]    wdApp.Visible = True[/COLOR]
    'If the macro has been run before, clean up any artifacts before trying to paste the table in again.
    On Error Resume Next
    With wdDoc.InlineShapes(1)
        .Select
        .Delete
    End With
    On Error GoTo 0
    
    'Turn off screen updating.
    Application.ScreenUpdating = False
    rnReport.Copy   'Copy the report to the clipboard.
    
    'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
    With wdbmRange
        .Select
        .PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
            Placement:=wdInLine, DisplayAsIcon:=False
    End With
    Application.ScreenUpdating = True
    MsgBox "The report has successfully been " & vbNewLine & "transferred to " & stWordReport, vbInformation
End Sub

 

[crvazquez954]

Thanks Dante, the code initially gave me an error but I realized it was simply missing the backslash so I added it to the code and it works, somewhat. It now keeps the word doc open but doesn't hide or omit blank rows. Is there anyway to do that?

 

[DanteAmor]

Thanks Dante, the code initially gave me an error but I realized it was simply missing the backslash so I added it to the code and it works, somewhat. It now keeps the word doc open but doesn't hide or omit blank rows. Is there anyway to do that?

You mean the rows of excel?

Change this

If WorksheetFunction.CountA(r) = 0 Then r.Hidden = True

By:

If WorksheetFunction.CountA(r) = 0 Then r.delete

Try again

 

[crvazquez954]

Could it be because some of the cells in the blank rows in the table have an IfError formula resulting in ""? Those cells are designed to pull information from other cells however, if those cells have no data then the resulting value in my range is simply "" and do not need to be transferred to the Word doc.

 

[crvazquez954]

Dante you are awesome!!! With your help I was able to tweak it and get it to work perfectly. I adjusted the line in the "For Each" statement to read:

"If WorksheetFunction.Count(r) = 0 Then r.Hidden = True"

I then recorded a macro to remove and restore the formatting and added it before and after the "For Each" Statement. I also added a statement near the end of the code to restore the hidden rows. Below is a copy of the code to help anyone else who may have the same issue.

Sub Export_Table_Word() 'FINAl TEST
'Name of the existing Word doc.
Const stWordReport As String = "Test.docm"

'Word objects.
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdbmRange As Word.Range

'Excel objects.
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnReport As Range
Dim r As Range

'Initialize the Excel objects.
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Summary")
Set rnReport = wsSheet.Range("BidTable")

'Remove formatting
Range("B28:D47").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With

For Each r In rnReport.Rows
If WorksheetFunction.Count(r) = 0 Then r.Hidden = True
Next

'Initialize the Word objects.
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Open(wbBook.Path & "" & stWordReport)
Set wdbmRange = wdDoc.Bookmarks("InsertHere").Range
wdApp.Visible = True
'If the macro has been run before, clean up any artifacts before trying to paste the table in again.
On Error Resume Next
With wdDoc.InlineShapes(1)
.Select
.Delete
End With
On Error GoTo 0

'Turn off screen updating.
Application.ScreenUpdating = False
rnReport.Copy 'Copy the report to the clipboard.

'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
With wdbmRange
.Select
.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, DisplayAsIcon:=False
End With

'Unhide hidden rows
Rows("26:48").Select
Selection.EntireRow.Hidden = False

'Restore formatting
Range("B28:D47").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With

Application.ScreenUpdating = True
MsgBox "The report has successfully been " & vbNewLine & "transferred to " & stWordReport, vbInformation
End Sub