Reference 3 spreadsheets and automatically insert formula

Hi guys,

In the attached example there are four spreadsheets in the workbook (Criteria, Workday Formula, Master Template and Internal Project plan).

What I need to do and can't figure out, is:

Fields:
1. On the Criteria Sheet the end user chooses a timeline (60/90/120) days and the launch date.
2. On the master templete there are three columns (Recommended Lead time 60, Recommended Lead time 90, and Recommended Lead time 120) that is based on regular days
3. On the Workday template I have done the comparison to figure out what the workday # of days vs a regular # of days is based on 60/90/120)

There is a macro built in here that pulls over the rows from the master template based on the criteria from the sheet "criteria" what I need is for the appropriate "reg days lead" on the internal project plan sheet to pull from the column on the master template and then match that to the workday formula sheet and "work days lead" to pull over based on whether the user chose 60/90/120.

Then I want to build in the "Due Date Column" on the internal project plan to make the workday formula =WORKDAY(Criteria!B3,-F7) copy all the way down where f7 changes to that actual row number to calculate the due dates and then hide the # of days fields.

There is probably a simpler way but I cannot find it.

I hope this isn't too confusing, if anyone help on this one the assistance is greatly appreciated. Thanks

MODIFIED POST: Ok, I was able to figure this out some on my own. I have now put the due dates in the sheet named master template.

I need to find a statement that can match Cell B5 from the criteria sheet, to pull in the correct cell (H if = 60, K if = 90, and N if = 120) into the column E on the internal project plan tab.

There is a macro that pulls in the data from the master template to the internal plan, but I do not know how to change it. It is below:

I appreciate any assistance you can provide. Thanks

Option Explicit

Private Sub CommandButton1_Click()
  Dim OutSH As Worksheet, TemplateSH As Worksheet, ce As Variant
  Dim DataCol As Integer, OutRow As Long, i As Long
  Dim arr As Variant
  Set OutSH = Sheets("Internal Project Plan")
  Set TemplateSH = Sheets("Master Template")
  
  For Each ce In Range("B15:B80")
    If ce = "Yes" Then
      DataCol = WorksheetFunction.Match(ce.Offset(0, -1).Value, TemplateSH.Rows("1:1"), 0)
      With TemplateSH
        For i = 2 To 700
          If .Cells(i, DataCol).Value = "x" Then
          'check to see if it already exists and only proceed if it does not
            If WorksheetFunction.CountIf(OutSH.Range("A:A"), TemplateSH.Cells(i, 1).Value) = 0 Then
              OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
              OutSH.Cells(OutRow, 1).Value = .Cells(i, 1).Value
              OutSH.Cells(OutRow, 2).Value = .Cells(i, 4).Value
              OutSH.Cells(OutRow, 3).Value = .Cells(i, 16).Value
              OutSH.Cells(OutRow, 4).Value = .Cells(i, 5).Value
              OutSH.Cells(OutRow, 9).Value = .Cells(i, 69).Value
            End If
          End If
        Next i
      End With
    End If
  Next ce
  Application.StatusBar = "Transferring Headings"
  arr = Array(2, 15, 77, 87, 461, 507, 534, 553, 582)
  With TemplateSH
    For i = LBound(arr) To UBound(arr)
      OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
      .Cells(arr(i), 1).Copy Destination:=OutSH.Cells(OutRow, 1)
      OutSH.Cells(OutRow, 1).Value = .Cells(arr(i), 1).Value
      .Cells(arr(i), 4).Copy Destination:=OutSH.Cells(OutRow, 2)
      OutSH.Cells(OutRow, 2).Value = .Cells(arr(i), 4).Value
      .Cells(arr(i), 10).Copy Destination:=OutSH.Cells(OutRow, 3)
      OutSH.Cells(OutRow, 3).Value = .Cells(arr(i), 10).Value
      .Cells(arr(i), 5).Copy Destination:=OutSH.Cells(OutRow, 4)
      OutSH.Cells(OutRow, 4).Value = .Cells(arr(i), 5).Value
      .Cells(arr(i), 69).Copy Destination:=OutSH.Cells(OutRow, 9)
      OutSH.Cells(OutRow, 9).Value = .Cells(arr(i), 69).Value
    Next i
  End With
  'sort output data
  Application.StatusBar = "Sorting Output"
  With OutSH
    .Range("A6:J" & .Cells(Rows.Count, 1).End(xlUp).Row).Sort key1:=.Range("A6"), order1:=xlAscending, header:=xlYes
   
  End With
    Application.StatusBar = False
   
With ActiveSheet
    For i = 7 To Range("B" & Rows.Count).End(xlUp).Row
        .Range("E" & i & ":I" & i).Interior.ColorIndex = .Range("B" & i).Interior.ColorIndex
    Next i
End With

Call Colors
Call Module6.SaveAs

End Sub

I have several other posts on this site about this project but on different issues. The links are below:

http://www.excelforum.com/showthread.php?t=649053

http://www.excelforum.com/showthread.php?t=649209

I have no open posts on any other site.

Hi guys, I am new to VB, I start classes on Wednesday but I have this project that is due before then, is there anyone that can assist?

I have not gotten a response on this one so have posted on another forum. The link is below.

http://www.mrexcel.com/forum/showthr...66#post1623366

We ended up using a select case code for this, below is the code:

Private Sub CommandButton1_Click()
  Dim OutSH As Worksheet, TemplateSH As Worksheet, ce As Variant
  Dim OutRow As Long, i As Long
  Dim arr As Variant
  Dim CopyRow As Boolean
  Set OutSH = Sheets("Internal Project Plan")
  Set TemplateSH = Sheets("Master Template")
  
'----------------- ADDED ------------------------------------
  Dim CriteriaSH As Worksheet
  Dim Timeline As Long
  Set CriteriaSH = Sheets("Criteria")
  
  Timeline = CriteriaSH.Range("B5")
  
  If Timeline <> 60 And _
     Timeline <> 90 And _
     Timeline <> 120 Then
     
     MsgBox ("Incorrect TimeLine")
     Exit Sub
  End If
'----------------- END ------------------------------------
  
      
'------------------ END -------------
      
 With TemplateSH
    For i = 2 To 700
       CopyRow = False
       For Each ce In CriteriaSH.Range("B15:B80")
          If ce = "Yes" Then
    
'------------------ CHANGED FROM WORKSHEET FUNCTION -------------
             Dim C As Variant
             Set C = TemplateSH.Rows("1:1").Find( _
                what:=ce.Offset(0, -1).Value, _
                LookIn:=xlValues, _
                lookat:=xlWhole)
             If C Is Nothing Then
                MsgBox ("Could not find : " & _
                   ce.Offset(0, -1).Value)
                Exit Sub
             Else
                If .Cells(i, C.Column).Value = "x" Then
                   CopyRow = True
                   Exit For
                End If
             End If
         End If
      Next ce
            
      If CopyRow = True Then
         OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
         OutSH.Cells(OutRow, "A").Value = .Cells(i, "A").Value
         OutSH.Cells(OutRow, "B").Value = .Cells(i, "D").Value
         OutSH.Cells(OutRow, "C").Value = .Cells(i, "P").Value
         OutSH.Cells(OutRow, "D").Value = .Cells(i, "E").Value
         OutSH.Cells(OutRow, "I").Value = .Cells(i, "BQ").Value
'--------------------------- New Code -----------------------
         Select Case Timeline
      
            Case 60
               OutSH.Cells(OutRow, "E").Value = _
                  .Cells(i, "H").Value
            Case 90
               OutSH.Cells(OutRow, "E").Value = _
                  .Cells(i, "K").Value
            Case 120
               OutSH.Cells(OutRow, "E").Value = _
                  .Cells(i, "N").Value
         End Select
      End If
'---------------------------End -----------------------------      End If
   Next i
 End With

  
 '----------------------------------------------------------------
  Application.StatusBar = "Transferring Headings"
  arr = Array(2, 16, 85, 97, 98, 111, 127, 145, 160, 185, 193, 196, 211, 241, 308, 329, 340, 433, 447, 451, 476, 522, 549, 568, 597)
  
  
  'moved outrow to this location and added counter inside loop
  OutRow = OutSH.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  With TemplateSH
    For i = LBound(arr) To UBound(arr)

      .Cells(arr(i), "A").Copy _
         Destination:=OutSH.Cells(OutRow, "A")
      
      'Duplicate of above row, eliminate
      'OutSH.Cells(OutRow, "A").Value = .Cells(arr(i), "A").Value
      
      .Cells(arr(i), "D").Copy _
         Destination:=OutSH.Cells(OutRow, "B")
      
      'Duplicate of above row, eliminate
      'OutSH.Cells(OutRow, "B").Value = .Cells(arr(i), "D").Value
      
      .Cells(arr(i), "J").Copy _
         Destination:=OutSH.Cells(OutRow, "C")
      
      'Duplicate of above row, eliminate
      'OutSH.Cells(OutRow, "C").Value = .Cells(arr(i), "J").Value
      
      .Cells(arr(i), "E").Copy _
         Destination:=OutSH.Cells(OutRow, "D")
      
      'Duplicate of above row, eliminate
      'OutSH.Cells(OutRow, "D").Value = .Cells(arr(i), "E").Value


      .Cells(arr(i), "BQ").Copy _
         Destination:=OutSH.Cells(OutRow, "I")
      
      'Duplicate of above row, eliminate
      'OutSH.Cells(OutRow, "I").Value = .Cells(arr(i), "BQ").Value
    
     'added row below
      OutRow = OutRow + 1
    Next i
  End With
  'sort output data
  Application.StatusBar = "Sorting Output"
  With OutSH
'-------------------------- CHANGED ------------------------------
   'change this statement
    .Range("A6:J" & (OutRow - 1)).Sort _
       key1:=.Range("A6"), _
       order1:=xlAscending, _
       header:=xlYes
 '---------------------------- ENd ---------------------------------
  End With
    Application.StatusBar = False
   
Sheets("Internal Project Plan").Select

Call Colors

Call Module6.SaveAs
End Sub