Adding more info to a cell Macros Calender

0

Hello, im just finishing a Calender program code which is going to check dates from a table in one sheet (sheet2) and by collecting the data from that cell in would locate the task that is need to be performance (like, cook pizza or wash clothes), and include it in the exact cell from the calender already made in another sheet(sheet1). My problem is that when two or more task share the same date, the macros only put one of them in the calender cell. Is there anyway to keep adding one or more task into this cell, without ereasing the previous ones? My cells size can be change if it is need it. Thanks for your help

Private Sub Refresh_Click()
    Dim Cont(1) As String
    Dim LookFor As Date
    Dim Fnd As Range
    Dim i As Integer
Range("B6:H6").ClearContents
Range("B8:H8").ClearContents
Range("B10:H10").ClearContents
Range("B12:H12").ClearContents
Range("B14:H14").ClearContents
Range("B16:H16").ClearContents
 For i = 60 To 102
 On Error Resume Next
  LookFor = Sheet1.Cells(i, "B").Value
    ' Se podría modificar el LookFor value asi: LookFor = CDate(Format(.Cells(40, "D").Value, "dd/mm/yyyy"))? Pendiente*
    
  If Err.Number <> 0 Then
  LookFor = Sheet1.Cells(110, "B").Value
  Resume Next
  End If
  
    
    
    With Sheet2.Range("B1:AK5")
        Set Fnd = .Find(What:=LookFor, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchByte:=False)
    End With
    
    If Fnd Is Nothing Then
       ' MsgBox "Fecha no encontrada.", vbInformation, "Invalid date" 'Lo pongo como comentario para ignorar el error
    Else
        Cont(0) = Sheet2.Cells(Fnd.Row, 2).Value
        Cont(1) = Sheet2.Cells(2, Fnd.Column).Value
    
           If i = 60 Then
          Sheet1.Cells(6, "B").Value = Join(Cont, " ")
           End If
           If i = 61 Then
          Sheet1.Cells(6, "C").Value = Join(Cont, " ")
          End If
           If i = 62 Then
          Sheet1.Cells(6, "D").Value = Join(Cont, " ")
          End If
           If i = 63 Then
          Sheet1.Cells(6, "E").Value = Join(Cont, " ")
           End If
           If i = 64 Then
          Sheet1.Cells(6, "F").Value = Join(Cont, " ")
           End If
           If i = 65 Then
          Sheet1.Cells(6, "G").Value = Join(Cont, " ")
           End If
           If i = 66 Then
          Sheet1.Cells(6, "H").Value = Join(Cont, " ")
           End If
           If i = 67 Then
          Sheet1.Cells(8, "B").Value = Join(Cont, " ")
           End If
           If i = 68 Then
          Sheet1.Cells(8, "C").Value = Join(Cont, " ")
          End If
           If i = 69 Then
          Sheet1.Cells(8, "D").Value = Join(Cont, " ")
          End If
           If i = 70 Then
          Sheet1.Cells(8, "E").Value = Join(Cont, " ")
           End If
           If i = 71 Then
          Sheet1.Cells(8, "F").Value = Join(Cont, " ")
           End If
           If i = 72 Then
          Sheet1.Cells(8, "G").Value = Join(Cont, " ")
           End If
           If i = 73 Then
          Sheet1.Cells(8, "H").Value = Join(Cont, " ")
           End If
           If i = 74 Then
          Sheet1.Cells(10, "B").Value = Join(Cont, " ")
           End If
           If i = 75 Then
          Sheet1.Cells(10, "C").Value = Join(Cont, " ")
          End If
           If i = 76 Then
          Sheet1.Cells(10, "D").Value = Join(Cont, " ")
          End If
           If i = 77 Then
          Sheet1.Cells(10, "E").Value = Join(Cont, " ")
           End If
           If i = 78 Then
          Sheet1.Cells(10, "F").Value = Join(Cont, " ")
           End If
           If i = 79 Then
          Sheet1.Cells(10, "G").Value = Join(Cont, " ")
           End If
           If i = 80 Then
          Sheet1.Cells(10, "H").Value = Join(Cont, " ")
           End If
            If i = 81 Then
          Sheet1.Cells(12, "B").Value = Join(Cont, " ")
           End If
           If i = 82 Then
          Sheet1.Cells(12, "C").Value = Join(Cont, " ")
          End If
           If i = 83 Then
          Sheet1.Cells(12, "D").Value = Join(Cont, " ")
          End If
           If i = 84 Then
          Sheet1.Cells(12, "E").Value = Join(Cont, " ")
           End If
           If i = 85 Then
          Sheet1.Cells(12, "F").Value = Join(Cont, " ")
           End If
           If i = 86 Then
          Sheet1.Cells(12, "G").Value = Join(Cont, " ")
           End If
           If i = 87 Then
          Sheet1.Cells(12, "H").Value = Join(Cont, " ")
           End If
             If i = 88 Then
          Sheet1.Cells(14, "B").Value = Join(Cont, " ")
           End If
           If i = 89 Then
          Sheet1.Cells(14, "C").Value = Join(Cont, " ")
          End If
           If i = 90 Then
          Sheet1.Cells(14, "D").Value = Join(Cont, " ")
          End If
           If i = 91 Then
          Sheet1.Cells(14, "E").Value = Join(Cont, " ")
           End If
           If i = 92 Then
          Sheet1.Cells(14, "F").Value = Join(Cont, " ")
           End If
           If i = 93 Then
          Sheet1.Cells(14, "G").Value = Join(Cont, " ")
           End If
           If i = 94 Then
          Sheet1.Cells(14, "H").Value = Join(Cont, " ")
           End If
           If i = 95 Then
          Sheet1.Cells(16, "B").Value = Join(Cont, " ")
           End If
           If i = 96 Then
          Sheet1.Cells(16, "C").Value = Join(Cont, " ")
          End If
           If i = 97 Then
          Sheet1.Cells(16, "D").Value = Join(Cont, " ")
          End If
           If i = 98 Then
          Sheet1.Cells(16, "E").Value = Join(Cont, " ")
           End If
           If i = 99 Then
          Sheet1.Cells(16, "F").Value = Join(Cont, " ")
           End If
           If i = 100 Then
          Sheet1.Cells(16, "G").Value = Join(Cont, " ")
           End If
           If i = 101 Then
          Sheet1.Cells(16, "H").Value = Join(Cont, " ")
           End If
        
End If
Next i
End Sub
Answer
Discuss

Answers

0

This procedure shows how to add another value to an existing cell value.

Private Sub JoinValues()
    Dim Addition As String
    
    With ActiveSheet
        Addition = .Cells(1, "A")
        With .Cells(2, "A")
            .Value = .Value & vbLf & Addition
        End With
    End With
End Sub

To test, take a blank sheet and enter something in A1 and A2. Run the sub and you will see the item from A1 added in a new line in A2.

Discuss

Answer the Question

You must create an account to use the forum. Create an Account or Login