Results 1 to 4 of 4

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

Threaded View

  1. #1
    Forum Contributor
    Join Date
    07-15-2011
    Location
    Whitby, Canada
    MS-Off Ver
    Excel 2010
    Posts
    121

    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
    Attached Files Attached Files
    Last edited by Greed; 02-17-2012 at 10:57 AM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1