Putting a textbox directly below another textbox in the same cell in Excel VBA

Question

I am creating a calendar feature which takes inputs from a form and based off that I will assign into a dynamic calendar.

The problem is that my third textbox and subsequent textbox will not be directly below the previous textbox created.
Calendar Image .

It is created in the position of the second textbox. How can I calculate the bottom position of the last created textbox?

Also how can I code it to automatically increase the row height accordingly when there is more than one textbox.

If Not searchCell Is Nothing Then
    Dim targetCell As Range
    Dim targetColumn As Long
    targetRow = searchCell.row
    targetColumn = searchCell.Column
    
    For Each targetCell In searchRange
        If IsDate(targetCell.Value) Then
            Dim currentDate As Date
            currentDate = DateValue(targetCell.Value)
            
            ' Compare currentDate with SVDateValue (day and month)
            If Day(currentDate) = Day(searchDate) And Month(currentDate) = Month(searchDate) Then
                'MsgBox currentDate
                'MsgBox Day(searchDate)
                'MsgBox Month(currentDate)
                'MsgBox Month(searchDate)
            
                ' Find the original textbox, if any
                Dim originalTextbox As Shape
                For Each originalTextbox In calendarSheet.Shapes
                    If originalTextbox.Type = msoTextBox Then ' Check if the shape is a textbox
                        If originalTextbox.TopLeftCell.row = targetRow And originalTextbox.TopLeftCell.Column = targetColumn Then
                            Exit For
                        End If
                    End If
                Next originalTextbox
                                
                ' Calculate the top position for the new textbox (below the original)
                Dim topPosition As Double
                If Not originalTextbox Is Nothing Then
                    topPosition = originalTextbox.Top + originalTextbox.Height + 1 ' Add some spacing
                Else
                    topPosition = calendarSheet.Cells(targetRow, targetColumn).Top
                End If
                
                Dim tb As Shape
                Set tb = calendarSheet.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
                  Left:=calendarSheet.Cells(targetCell.row, targetCell.Column).Left, _
                  Top:=topPosition, _
                  Width:=calendarSheet.Cells(targetCell.row, targetCell.Column).Width, _
                  Height:=80)

                'Height:=calendarSheet.Cells(targetCell.row, targetCell.Column).Height) Automatic Fit to Box
                
                ' Set properties for the TextBox
                tb.Fill.Transparency = 1 ' Fully transparent fill
                tb.Line.Visible = msoFalse ' No border
                
                ' Set TextBox text to SVDate and company values
                tb.TextFrame2.TextRange.Text = SVDateValue & vbCrLf & DPValue & vbCrLf & companyValue & vbCrLf & SVTimeValue

                ' Change color of SVDateValue text to white
                'tb.TextFrame2.textRange.Characters(1, Len(SVDateValue)).Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
                tb.TextFrame2.TextRange.Characters(1, Len(SVDateValue)).Font.Fill.Visible = msoFalse 'Making ServiceDate Color to Not Filled
            End If
        End If
    Next targetCell
    
    ' Update the month and year cells
    'calendarSheet.Range("D1").Value = extractedMonth
    'calendarSheet.Range("G1").Value = extractedYear
    
Else
    MsgBox "Date not found in the specified range.", vbExclamation
End If

Yes i tried that also but like i will be using the original top + height and i cant get like the previous textbox top + height. If possible can u rewrite and show me to allow me to better understand and see from there. Appreciate Very Much — Kingly Lee, Aug 12 '23 at 16:58
Since you use one cell for one date, set the cell value to the count of events and hide them (e.g. color=backcolor). With this can fast calculate the next position based on the cell coordinates and the count of textboxes. — Black cat, Aug 12 '23 at 17:17
but the problem im facing is cause i want these 3 textbox created is in the same cell since they are in the same dates but i have problems referring to the previous textbox bottom value. How can i get the previous textbox bottom value — Kingly Lee, Aug 12 '23 at 18:26
`Cells(x,y).Top + TextBox.Height * n` , where n is the count of the textboxes. — Black cat, Aug 13 '23 at 03:44
If you're looking for the previous values, just assign them variables when they are valid and use the variables as needed. — Frank Ball, Aug 14 '23 at 15:44

score 0 · Answer 1 · answered Aug 12 '23 at 17:51

The provided code shows how to add TextBoxes which is next to each other and adjust their anchor cell height.

Question: how can i code it so like it will automatically increase the row height accordingly when there is more then 1 textbox.

Answer: Compare the TextBox top position plus height to the anchor cell row height. Adjust the row height as needed, up to the 409.1 maximum.

Sub demo()
    Dim anchorCell As Range, i As Integer
    Dim objShp As Shape
    Dim topPos, leftPos, widthTxt, heightTxt, endPos
    ActiveSheet.DrawingObjects.Delete
    Set anchorCell = [c1]
    widthTxt = 150 ' TextBox width
    heightTxt = 50 ' TextBox height
    For i = 0 To 2 ' Add 3 TextBox in anchorCell
        ' TextBox top-left location
        topPos = anchorCell.Top + i * heightTxt
        leftPos = anchorCell.Left
        ' Add TextBox
        Set objShp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                leftPos, topPos, widthTxt, heightTxt)
        objShp.Placement = xlFreeFloating
    Next
    ' Adjust archor cell to fit TextBox
    endPos = topPos + heightTxt
    If anchorCell.Height < topPos + heightTxt Then
        ' Max row height is 409.1
        anchorCell.EntireRow.RowHeight = IIf(endPos < 409.1, endPos, 409.1)
    End If
End Sub

Putting a textbox directly below another textbox in the same cell in Excel VBA

1 Answers1