Looping, Copying, Pasting to Word Doc

[tgamekh]

Hi,


I have a worksheet, with about 100 populated rows with content in multiple columns.

I am trying to write a vba script which loops through column F and checks for the text “Fail” or “Partial Fail”. If true, it will copy the content from Column C and Column G and paste it into a Word document separated by a hyphen grouped/ordered by Column A and then sub-grouped/ordered by items that failed first and then partial fails.

I am posting from my phone or else I would attach an example of the worksheet, and am hoping my explanation is detailed enough. ?

In the searching I have done, I have not come across a single source which explains/shows a similar example that I can even use as a starting point.
Please, thank you, and take care.

 

[NdNoviceHlp]

Hi tgamekh and Welcome to the Board! Don't really follow what U want to do... loop column "F" for either "Fail" or "Partial Fail" then if true... (what's true... whether either "Fail" or Partail Fail" exist?) then copy content from Columns "C" & "G" (what content.. only the row where true exists or the whole column?) then paste in Word (Where... in new document or existing document or template and then where in the document and/or in what ie. a table?) after that I don't follow the "separated by a hyphen grouped/ordered by Column A and then sub-grouped/ordered by items that failed first and then partial fails." part at all. It is possible to copy and paste stuff from XL to Word but you need to know where you're going before U start. Dave

 

[Macropod]

You could do all that with a mailmerge or, perhaps, a DATABASE field in Word. No VBA code required.

 

[tgamekh]

Hi tgamekh and Welcome to the Board! Don't really follow what U want to do... loop column "F" for either "Fail" or "Partial Fail" then if true... (what's true... whether either "Fail" or Partail Fail" exist?) then copy content from Columns "C" & "G" (what content.. only the row where true exists or the whole column?) then paste in Word (Where... in new document or existing document or template and then where in the document and/or in what ie. a table?) after that I don't follow the "separated by a hyphen grouped/ordered by Column A and then sub-grouped/ordered by items that failed first and then partial fails." part at all. It is possible to copy and paste stuff from XL to Word but you need to know where you're going before U start. Dave

Dave,

All fair points and questions, in my head as I was writing it all made perfect sense. I have attached a snip (3 of the roughly 100 total rows) of the worksheet I am working in. I am hoping the following will help to clarify.

(what's true... whether either "Fail" or Partial Fail" exist?) - that is correct. other options exist; however, I am only interested in producing a word doc with items that are found to "Fail" or "Partial Fail".

(what content.. only the row where true exists or the whole column?) - using the screen snip attached, the outputted content would be as follows:
PR.AC-1: - In order to do better, do this.
PR.AC-2: - In order to do better, do this, and this, and this.

PR.AC-3 would not require output to the word document as it passed and there is no feedback to give.

(Where... in new document or existing document or template and then where in the document and/or in what ie. a table?) - a new word document, just listed in lines of plain text in a list.


"separated by a hyphen grouped/ordered by Column A and then sub-grouped/ordered by items that failed first and then partial fails." - Such as, all "failed" content would be sorted (perhaps grouped was the wrong term?) and listed first, and then "partially failed" content would be grouped and listed after. Regarding the hyphen separation, see the two examples above.

The end result would be a script that checks cell F of each row. If the test failed or partially failed, it would copy cell C and G of that row and paste it to a word document in a list (no table) sorted by failures, then partial failures.

Thank you for taking the time,

Dave

 

[NdNoviceHlp]

Hi Dave. I'm not sure if this is something that can be done as Macropod suggested with either mailmerge or a database field but I'm guessing it is possible to do a VBA solution. Would U be opposed to organizing your output in some type of table format. Their could be multiple tables of varied column/rows... or not and do something else? Dave

 

[tgamekh]

Dave,
I have figured out a method to get what I was looking for in my request. It might not be the most glamorous but it is working.

Essentially, I am copying the cells from the rows I highlighted above when the condition "fail" or "partial fail" are met, to another hidden sheet. This allows me to manipulate the cells and data and put them into the string that I wish to have for my word document. This allows me to perform additional actions, such as sorting to put in the list order that I am looking for. I than have it cut and paste into a new word document and apply formatting, as desired. Once it's all done it resets the hidden sheet to be ready fo the next time the task runs. Like I said, not glamorous, and looking over the code I have a long way to come to clean things up and be more effiicient, but as my arguably first project built from scratch (with a few borrowed bits), I am proud of it.

I am looking to the mailmerge idea as well and becoming more educated on it. Now that this task is accomplished, I have another, more complex one to tackle which I am guessing either mailmerge will work or possibly building a template work document and then populating the template word docs based on cell values.

I appreciate the time and assistance.

If anyone is interested, here is the result of my project. Again, it's rough around the edges and I am guessing there is alot that can improve on it. But there is no sense in not sharing as somehting in here might help someone else.

Sub PrintExit()


Dim wdApp As Word.Application, wdDoc As Word.Document
Dim datasheet As Worksheet
Dim exitsheet As Worksheet
Dim testresultfail As String
Dim testresultpartialfail As String
Dim finalrow As Integer
Dim i As Integer


Application.StatusBar = "Creating new document..."
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Add
With wdDoc
    .SaveAs2 FileName:="HIPAA Exit Wording.docx"
    .PageSetup.Orientation = wdOrientPortrait
End With

Application.ScreenUpdating = False

Set datasheet = Sheet2
Set exitsheet = Sheet3


Sheets("Exit").Visible = True

testresultfail = "Fail"
testresultpartialfail = "Partial Fail"

exitsheet.Range("A1:ZZ500").ClearContents

datasheet.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To finalrow
    If Cells(i, 6) = testresultfail Or Cells(i, 6) = testresultpartialfail Then

    Range(Cells(i, 1), Cells(i, 7)).Copy
    exitsheet.Select
    Range("a200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    datasheet.Select
    End If
    
Next i
    
    
exitsheet.Select

    ActiveWorkbook.Worksheets("Exit").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Exit").Sort.SortFields.Add2 Key:=Range("A2:A7"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "Identify,Protect,Detect,Respond,Recover", DataOption:=xlSortNormal
        ActiveWorkbook.Worksheets("Exit").Sort.SortFields.Add2 Key:=Range("F2:F7"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "Fail,Partial Fail", DataOption:=xlSortNormal
    
    With ActiveWorkbook.Worksheets("Exit").Sort
        .SetRange Range("A2:G98")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  
exitsheet.Select

Cells(1, 8).Value = "Identify"
Cells(1, 9).Value = "Protect"
Cells(1, 10).Value = "Detect"
Cells(1, 11).Value = "Respond"
Cells(1, 12).Value = "Recover"


For i = 2 To finalrow
    If Cells(i, 1) = "IDENTIFY" Then
    Cells(i, 8).Value = Cells(i, 3).Value & " " & Cells(i, 7).Value
    
    ElseIf Cells(i, 1) = "PROTECT" Then
    Cells(i, 9).Value = Cells(i, 3).Value & " " & Cells(i, 7).Value
    
    ElseIf Cells(i, 1) = "DECTECT" Then
    Cells(i, 10).Value = Cells(i, 3).Value & " " & Cells(i, 7).Value
    
    ElseIf Cells(i, 1) = "RESPOND" Then
    Cells(i, 11).Value = Cells(i, 3).Value & " " & Cells(i, 7).Value
    
    ElseIf Cells(i, 1) = "RECOVER" Then
    Cells(i, 12).Value = Cells(i, 3).Value & " " & Cells(i, 7).Value
    
End If


Dim blankrng As Range

On Error GoTo NoBlanks
Set blankrng = Range("H1:L98").SpecialCells(xlCellTypeBlanks)
blankrng.Rows.Delete shift:=xlShiftUp

NoBlanks:
    Resume Next


Next i

For Each ws In ActiveWorkbook.Worksheets
    If ws.Name = "Exit" Then
    Application.StatusBar = "Copying data from " & ws.Name & "..."
    
    If Range("H2") <> "" Then
    
    ws.Range("H1").Copy
 
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
        .PasteAndFormat wdFormatPlainText
        .ParagraphFormat.SpaceAfter = 0
        .Font.Name = "Times New Roman"
        .Font.Color = wdColorBlank
        .Font.Bold = True
        .Font.Italic = False
        .Font.Allcaps = False
        .Font.Size = 11
        .Borders(wdBorderBottom).Visible = True
    End With
    
    
    ws.Range("H2:H98").SpecialCells(xlCellTypeConstants).Copy
 
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    
    
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
    
        
        .PasteAndFormat wdFormatPlainText
        .ListFormat.ApplyBulletDefault
        .ParagraphFormat.SpaceAfter = 0
        .Font.Name = "Times New Roman"
        .Font.Color = wdColorBlank
        .Font.Bold = False
        .Font.Italic = False
        .Font.Allcaps = False
        .Font.Size = 11
        .Borders(wdBorderBottom).Visible = False
    
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    
    End With
    
    Else: End If
        
    
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
    
        .Paragraphs.Outdent
        .ListFormat.RemoveNumbers
    End With
    
    If Range("I2") <> "" Then
    
    ws.Range("I1").Copy
    
    
    
    
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
        .Paragraphs.Outdent
        .ListFormat.RemoveNumbers
        .PasteAndFormat wdFormatPlainText
        .ParagraphFormat.SpaceAfter = 0
        .Font.Name = "Times New Roman"
        .Font.Color = wdColorBlank
        .Font.Bold = True
        .Font.Italic = False
        .Font.Allcaps = False
        .Font.Size = 11
        .Borders(wdBorderBottom).Visible = True
    End With
    ws.Range("I2:I98").SpecialCells(xlCellTypeConstants).Copy
 
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    
    
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
    
        
        .PasteAndFormat wdFormatPlainText
        .ListFormat.ApplyBulletDefault
        .ParagraphFormat.SpaceAfter = 0
        .Font.Name = "Times New Roman"
        .Font.Color = wdColorBlank
        .Font.Bold = False
        .Font.Italic = False
        .Font.Allcaps = False
        .Font.Size = 11
        .Borders(wdBorderBottom).Visible = False
    
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    End With
    
    Else: End If

    
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
    
        .Paragraphs.Outdent
        .ListFormat.RemoveNumbers
    End With

    If Range("J2") <> "" Then

    
               ws.Range("J1").Copy
                
                  
               wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
              
               With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
                   .Paragraphs.Outdent
                   .ListFormat.RemoveNumbers
                   .PasteAndFormat wdFormatPlainText
                   .ParagraphFormat.SpaceAfter = 0
                   .Font.Name = "Times New Roman"
                   .Font.Color = wdColorBlank
                   .Font.Bold = True
                   .Font.Italic = False
                   .Font.Allcaps = False
                   .Font.Size = 11
                   .Borders(wdBorderBottom).Visible = True
               End With
               ws.Range("J2:J98").SpecialCells(xlCellTypeConstants).Copy
            
               wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
              
              
               With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
              
                  
                   .PasteAndFormat wdFormatPlainText
                   .ListFormat.ApplyBulletDefault
                   .ParagraphFormat.SpaceAfter = 0
                   .Font.Name = "Times New Roman"
                   .Font.Color = wdColorBlank
                   .Font.Bold = False
                   .Font.Italic = False
                   .Font.Allcaps = False
                   .Font.Size = 11
                   .Borders(wdBorderBottom).Visible = False
               End With
            wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    
    Else: End If
    
    
    
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
    
        .Paragraphs.Outdent
        .ListFormat.RemoveNumbers
    End With
    
If Range("K2") <> "" Then
    
    ws.Range("K1").Copy
    
    
    
    
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
        .Paragraphs.Outdent
        .ListFormat.RemoveNumbers
        .PasteAndFormat wdFormatPlainText
        .ParagraphFormat.SpaceAfter = 0
        .Font.Name = "Times New Roman"
        .Font.Color = wdColorBlank
        .Font.Bold = True
        .Font.Italic = False
        .Font.Allcaps = False
        .Font.Size = 11
        .Borders(wdBorderBottom).Visible = True
    End With
    ws.Range("K2:K98").SpecialCells(xlCellTypeConstants).Copy
 
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    
    
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
    
        
        .PasteAndFormat wdFormatPlainText
        .ListFormat.ApplyBulletDefault
        .ParagraphFormat.SpaceAfter = 0
        .Font.Name = "Times New Roman"
        .Font.Color = wdColorBlank
        .Font.Bold = False
        .Font.Italic = False
        .Font.Allcaps = False
        .Font.Size = 11
        .Borders(wdBorderBottom).Visible = False
    
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    End With
    Else: End If
    
    
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
    
        .Paragraphs.Outdent
        .ListFormat.RemoveNumbers
    End With
    
    If Range("K2") <> "" Then
    ws.Range("L1").Copy
    
    
    
    
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
        .Paragraphs.Outdent
        .ListFormat.RemoveNumbers
        .PasteAndFormat wdFormatPlainText
        .ParagraphFormat.SpaceAfter = 0
        .Font.Name = "Times New Roman"
        .Font.Color = wdColorBlank
        .Font.Bold = True
        .Font.Italic = False
        .Font.Allcaps = False
        .Font.Size = 11
        .Borders(wdBorderBottom).Visible = True
    End With
    ws.Range("L2:L98").SpecialCells(xlCellTypeConstants).Copy
 
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    
    
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
    
        
        .PasteAndFormat wdFormatPlainText
        .ListFormat.ApplyBulletDefault
        .ParagraphFormat.SpaceAfter = 0
        .Font.Name = "Times New Roman"
        .Font.Color = wdColorBlank
        .Font.Bold = False
        .Font.Italic = False
        .Font.Allcaps = False
        .Font.Size = 11
        .Borders(wdBorderBottom).Visible = False
    
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    End With
    
    Else: End If
    
  
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
    
        .Paragraphs.Outdent
        .ListFormat.RemoveNumbers
    End With
    
    Application.CutCopyMode = False
    End If



Next ws
Set ws = Nothing
Application.StatusBar = "Cleaning up..."
With wdApp.ActiveWindow
    If .View.SplitSpecial = wdPaneNone Then
        .ActivePane.View.Type = wdPrintView
    Else
        .View.Type = wdPrintView
    End If
End With
Set wdDoc = Nothing
wdApp.Visible = True
Set wdApp = Nothing
Application.StatusBar = False









exitsheet.Range("A1:ZZ500").ClearContents

Sheets("Exit").Visible = False

Sheets("Audit Data").Activate
ActiveSheet.Cells(2, 2).Select

End Sub

 

[NdNoviceHlp]

Thanks for posting your outcome. Stay safe. Dave