Thread: Code to pull cells into a new workbook based on content of adjacent cells

Hi all,

I have what might be a very complicated idea I would like to implement for reporting purposes - to be used by a beginner Excel user (not me).
I have shift reports that are submitted 2x daily (sample attached). What I want to do is to pull a report based on the criteria outlined below.
The individual shift reports are saved in a specific folder. I want to add a button (for the basic user) on a *new* spreadsheet/report that will act like this code I have used for another report (go to to the specified 'unprocessed' folder, open the Word forms, populate the spreadsheet with the form fields, close the document and transfer it to the specified 'processed' folder).

Dim vField As FormField
Dim fso As Scripting.FileSystemObject
Dim fsDir As Scripting.Folder
Dim fsFile As Scripting.File
Dim wdApp As Word.Application
Dim myDoc As Word.Document
Dim vColumn As Integer
Dim vLastRow As Integer
Dim x As Integer


Sub AddFormFields()

vLastRow = ActiveSheet.UsedRange.Rows.Count + 1
vColumn = 1

Set fso = New Scripting.FileSystemObject

Set fsDir = fso.GetFolder _
("Z:\FireClerical\NANCE - LINDA\Gillian\J. Bentley\Unprocessed")

Set wdApp = New Word.Application
wdApp.Visible = True

For Each fsFile In fsDir.Files

wdApp.Documents.Open (fsFile)

Set myDoc = wdApp.ActiveDocument

For Each vField In wdApp.Documents(myDoc).FormFields

vField.Select

vValue = vField.Result

Workbooks("Daily Vehicle Inspection tracking.xls").Activate
Cells(vLastRow, vColumn).Select

If vField.Type = 71 Then

Select Case vField.Name

Case "Check1"
vColumn = vColumn - 1
If vField.Result = "1" Then
ActiveCell.Value = "YES"
End If

Case "Check2"
If vField.Result = "1" Then
ActiveCell.Value = "NO"
End If

End Select

Else

ActiveCell.Value = vValue
End If

vColumn = vColumn + 1

Next

vColumn = 1
vLastRow = vLastRow + 1

vFileName = wdApp.ActiveDocument.Name

wdApp.ActiveDocument.Close

Name fsFile As _
"Z:\FireClerical\NANCE - LINDA\Gillian\J. Bentley\Processed\Processed" & vFileName

Next

wdApp.Quit
    
    
End Sub

For the purpose of this macro, I only want to copy cells if the shift report contains any shift-codes containing "AC" or "APC" (highlighted in yellow in my attached sample). If any of the cells in the range A3:F26 cell contains that criteria then:

Copy the cell to the right (containing the empoyee name) of the code into one colum, then copy the *required* cell (containg the code with "AC" or "APC" in it) into the next column - also:

Copy the cell E20 (showing the date) into another column (repeating)
Copy the cell A1 (showing the shift ID) into another column (repeating)
Copy the cell E18 (showing the shift hours) into another column (repeating)

Copy values only - not formulas

I have included another tab in the workbook to show how I would like the report to turn out - In the end, I need to use the report to tell me the number of hours each employee has for specific shift codes each month by filtering or using another macro - whatever, first things first!
I know this is asking a lot, but sure could use your expertise! TIA