Posts by Robert B

Sub MultiEntryCell()


    Dim myDate As Date
    Dim myPhase As String
    Dim myPM As String
    Dim myPM2 As String
    Dim myPM3 As String
    Dim myPM4 As String
    Dim myLocation As String
    Dim myLocation2 As String
    Dim myLocation3 As String
    Dim myLocation4 As String
    Dim myRange As Range
    Dim myRange2 As Range
    Dim i As Integer
    Dim j As Integer
    ActiveCell.FormulaR1C1 = "=COUNTIF(Data!RC:R[16]C,R[1]C)"
     j = ActiveCell
     
     i = 1
     ActiveCell.Offset(1, 0).Select
      
      myDate = ActiveCell
      
      myPhase = Range("A3")
    
    Range("C3").Select
        Set myRange = ActiveCell
   
    Sheets("Data").Select
    Range(myPhase).Select
    Selection.End(xlUp).Select
    Range(Selection, Selection.End(xlDown)).Select
    
    For i = 1 To j
    
    Selection.Find(what:=myDate, after:=ActiveCell, LookIn:=xlFormulas _
        , lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False).Activate       
        
If i = 1 Then
        Set myRange2 = ActiveCell
        ActiveCell.Offset(0, -2).Select
         myPM = ActiveCell
        ActiveCell.Offset(0, 1).Select
     myLocation = ActiveCell
     Application.Goto myRange2
     Range(Selection, Selection.End(xlDown)).Select
End If


If i = 2 Then
        Set myRange2 = ActiveCell
        ActiveCell.Offset(0, -2).Select
        myPM2 = ActiveCell
        ActiveCell.Offset(0, 1).Select
         myLocation2 = ActiveCell
        Application.Goto myRange2
     Range(Selection, Selection.End(xlDown)).Select
End If
 If i = 3 Then
        Set myRange2 = ActiveCell
        ActiveCell.Offset(0, -2).Select
         myPM3 = ActiveCell
        ActiveCell.Offset(0, 1).Select
         myLocation3 = ActiveCell
        Application.Goto myRange2
     Range(Selection, Selection.End(xlDown)).Select
End If
If i = 4 Then
        Set myRange2 = ActiveCell
        ActiveCell.Offset(0, -2).Select
         myPM4 = ActiveCell
        ActiveCell.Offset(0, 1).Select
         myLocation4 = ActiveCell
        Application.Goto myRange2
     Range(Selection, Selection.End(xlDown)).Select
End If
'i = i + 1
Next i
Application.Goto myRange
    
    ActiveCell = myPM & " " & "in" & " " & myLocation & Chr(10) _
    & myPM2 & " " & "in" & " " & myLocation2 & Chr(10) _
    & myPM3 & " " & "in" & " " & myLocation3 & Chr(10) _
   & myPM4 & " " & "in" & " " & myLocation4
  
End Sub