Show only required data and transfer to MS Word

N

Neil_Pattison

I have a spreadsheet that shows some materials we use in our company
The first column shows a description of the material, the second colum
shows the catalogue number of the material and the third column is lef
open for the user to enter in the required quantity.

I have attached to the spreadsheet a command button but I need som
help with the VB coding. What I'd like to do is have the user enter th
required quantities in the 3rd column and then click on this comman
button which would then only show the rows that have had quantitie
entered. If I could get this done it would be sufficient.

However if it is possible I would then like to have these rows tranfe
into an order form which i already have developed in MS Word.

Any help with this would be greatly appreciated
 
J

John 2005

Hello

You can use ( I assume you know how to send to MS word)

John
http://BaRaN-Systems.com

Sub Macro1()
'
' Macro1 Macro
'
'
Range("A2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=">0", Operator:=xlAnd

totalrows = ActiveSheet.UsedRange.Rows.Count

Range("A1:C" & totalrows).Select
Selection.Copy
Application.CutCopyMode = False
Selection.AutoFilter Field:=3
'
' send to MS Word
'
Range("C2:C" & totalrows).Select
Selection.ClearContents
Range("C2").Select
End Sub
 
J

John 2005

Hello

A Better solution is...

Regards,
John
http://BaRaN-Systems.com


Sub Copy_to_word()
'
' Macro1 Macro
'
Dim Number_of_rows As Long
Dim Total_Rows As Long

Range("D1").Select
Total_Rows = ActiveSheet.UsedRange.Rows.Count
Range("A1:D" & Total_Rows).Sort Key1:=Range("C2"),
Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveCell.FormulaR1C1 = "=COUNT(R[1]C[-1]:R[" & Total_Rows &
"]C[-1])"
Number_of_rows = Range("D1").Value

'
' send to MS Word
'
Call send_to_MS_word(Number_of_rows)


Range("C2:C" & Total_Rows).Select
Selection.ClearContents

Range("C1").Select
Selection.ClearContents
Range("A1").Select
End Sub

Sub send_to_MS_word(Number_of_rows As Long)

Dim WordApp As Word.Application, WordDoc As Word.Document, myworksheet
As Worksheet
Application.ScreenUpdating = False
Application.StatusBar = "Creating a new document"
Set WordApp = New Word.Application
Set WordDoc = WordApp.Documents.Add
'
' Now copy the content of all worksheets here
'
For Each myworksheet In ActiveWorkbook.Worksheets

Application.StatusBar = "Opening worksheet " & myworksheet.Name

myworksheet.Range(Cells(1, 1), Cells(Number_of_rows + 1,
3)).Copy

'
' Paste it
'

WordDoc.Paragraphs(WordDoc.Paragraphs.Count).Range.InsertParagraphAfter
WordDoc.Paragraphs(WordDoc.Paragraphs.Count).Range.Paste
Application.CutCopyMode = False

WordDoc.Paragraphs(WordDoc.Paragraphs.Count).Range.InsertParagraphAfter

If Not myworksheet.Name = Worksheets(Worksheets.Count).Name
Then
With WordDoc.Paragraphs(WordDoc.Paragraphs.Count).Range
.InsertParagraphBefore
.Collapse Direction:=WordCollapseEnd
.InsertBreak Type:=WordPageBreak
End With
End If
Next myworksheet


Set myworksheet = Nothing
Application.StatusBar = "Cleaning up..."

Set WordDoc = Nothing
WordApp.Visible = True
Set WordApp = Nothing
Application.StatusBar = False '

End Sub
 
Top