VBA help - removing rows with no values

[Jasesair]

I have a range of data in Excel that I'm filtering (a named range that's actually B34:J52), then pasting into a formatted area in Excel (B9:A52), before copying this range (B9:A52) in MS Word. The range that's been filtered and pasted cannot be changed but potentially there are rows with no values at all. I'd love a line of code that recognises there are no values, resulting in only the required rows being copied in MS Word. I'm hoping this makes sense!!!

I really don't know where the line of code should go so I'll share my whole module. Hoping that's alright! Any help would be very much appreciated.

Sub CreateMarkingGuide1() 'UPDATE

Application.ScreenUpdating = False
Sheets("Marking Guides (2)").Visible = True

Call CopyPasteMGuide_Y3U1 'UPDATE
Call ExcelRangeToWordv21 'UPDATE

Sheets("Marking Guides (2)").Visible = False

End Sub

Sub FilterOutBlanks1() 'UPDATE

ActiveWorkbook.Sheets("Marking Guides (2)").Range("Y3U1").AutoFilter Field:=(2), Criteria1:="<>" 'UPDATE

End Sub
Sub CopyPasteMGuide_Y3U1() 'UPDATE

ThisWorkbook.Worksheets("Marking Guides (2)").Select
Range("b9:j25").ClearContents 'UPDATE

Call FilterOutBlanks1 'UPDATE

Range("b35:j52").Copy 'UPDATE
Range("b9").PasteSpecial Paste:=xlPasteValues 'UPDATE
Range("a9:a25").EntireRow.AutoFit 'UPDATE

Range("Y3U1").AutoFilter Field:=(2) 'UPDATE
Range("d9:d25").ClearContents 'UPDATE



End Sub
Sub ExcelRangeToWordv21() 'UPDATE

Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

'Copy Range from Excel
  Set tbl = ThisWorkbook.Worksheets("Marking Guides (2)").Range("b9:j25") 'UPDATE
  Set Header = ThisWorkbook.Worksheets("Marking Guides (2)").Range("b1:j7") 'UPDATE
  Set Sheet = ThisWorkbook.Worksheets("Marking Guides (2)")
'If MS Word is already open
' Set WordApp = GetObject("Word.Application")

'If MS Word is not already open then open MS Word
  If WordApp Is Nothing Then Set WordApp = CreateObject("Word.Application")

'Make MS Word Visible and Active
  WordApp.Visible = True


'Create a New Document
  Set myDoc = WordApp.Documents.Add

'Copy Header range
  Sheet.Select
  Header.Select
  Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

'Set Word Margins
With WordApp.ActiveDocument.PageSetup
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(0.5)
.BottomMargin = CentimetersToPoints(1)
.LeftMargin = CentimetersToPoints(1)
.RightMargin = CentimetersToPoints(1)
End With

'Change the view to header & footer
If WordApp.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
WordApp.ActiveWindow.Panes(2).Close
End If

'Select the Header range and paste as image
WordApp.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False

  
WordApp.ActiveWindow.View.Type = wdNormalView
WordApp.ActiveWindow.View.Type = wdPrintView


  'Copy Excel Table range
  Sheet.Select
  tbl.Copy

'Paste Table into Word
myDoc.Content.Paste



'Autofit Table so it fits inside Word Document
Set WordTable = myDoc.Tables(1)
WordTable.AutoFitBehavior (wdAutoFitWindow)


Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False
 
  ThisWorkbook.Worksheets("Class Setup").Select

   WordApp.Activate


End Sub

 

[JLGWhiz]

I am not sure what you are working with, but assuming that yop have a range of dada in A1:E12 of a worksheet, and some of the rows contain formulas that return NullSting ("" if conditions exist or are otherwise blank making the entire row appear blank, and you only want rows with visible text and numbers to copy to F1:J & whatever.

Range("A1:E12").SpecialCells(xlCellTypeConstants, 3).Copy Range("F1")

Ths would require that all the cells in the copied rows have data. If there are empty cells in those rows, it could cause an error.

 

[Jasesair]

Thanks for the reply. Would you be able to show me where in my module that such a line should go/replace? Many thanks.

 

[JLGWhiz]

Thanks for the reply. Would you be able to show me where in my module that such a line should go/replace? Many thanks.

I don't believe you can just plug it into the code you have posted. The code you have has a procedure to filter out the blank rows, Is that not working for you?

 

[Jasesair]

That filtering is a step prior. The end result is I'm sending a range of cells to be opened in MS Word. Some of these will have text in the cells but the constant range being sent to MS Word may have some rows with no values. I'm looking for some code to 'clean up' when pasted into Word so I'm not left with a bunch of unnecessary empty rows.

 

[JLGWhiz]

Sorry, I cannot work it into your code because of the way the table is created in Word. It would take a major rewrite of your code and I am not up to that.
Regards, JLG

 

[Julien888]

Hi, I am not sure to understand, if you use autofilter with "<>" it should remove empty values and if you copy and paste the table manually it should remove the empty line, shouldn't it? so if you record a macro of you manually copying and pasting after autofiltering and use that piece of code it should work I guess... (considering your filter field is one which is empty if each field in the row is empty, which is quite easy to do). Otherwise if not possible to do it in Excel, you could do it afterwards in Word, here is a piece of code I used to remove empty rows in some tables in Word, except for me I could simply delete the line if column 2 was empty, so in your case I guess you can simply use And for every column number (j,1) (j,2) (j,3) and so on or use another For loop with a k and a If adding 1 to an integer variable whenever it is not empty and deleting row j when that variable is 0 at the end of the k loop.

nbtab = ActiveDocument.Tables.Count
 For i = 1 To nbtab Step 1
 ActiveDocument.Tables(i).Rows(1).HeadingFormat = True
 ActiveDocument.Tables(i).Rows.Alignment = wdAlignRowCenter
 ActiveDocument.Tables(i).Rows(1).Select
 Selection.ParagraphFormat.SpaceAfter = 0
nblignes = ActiveDocument.Tables(i).Rows.Count
 For j = nblignes To 1 Step -1
 If ActiveDocument.Tables(i).Cell(j, 2).Range.Text = Chr(160) & Chr(13) & Chr(7) Then
 ActiveDocument.Tables(i).Rows(j).Delete
 End If
 Next j
 Next i

 

[Jasesair]

The filtering is working well. I think the line of code that needs some more thought is in the ExcelRangeToWordv21 part of the module, with the line:

Set tbl = ThisWorkbook.Worksheets("Marking Guides (2)").Range("b9:j25")

It's bringing into MS Word this entire range, but I'd like it to only bring the rows needed. The blank rows will always be the last rows in this range, if that helps.

Hoping this makes sense.

 

[JLGWhiz]

Try changing that line to

Set tbl = ThisWorkbook.Worksheets("Marking Guides (2)").Range("b9:j25").SpecialCells(xlCellTypeConstants, 3)

 

[Jasesair]

As your name suggests, you really are a Whiz!!! Thanks so much - this worked perfectly. Really do appreciate your time.