Problem adding a tool tip to R shiny dashboard valueBox

I would like to add a tooltip to a valueBox subtitle, but I have an issue doing this - specifically when the valueBox has been generated in the server.

In my example you can see for Value 2, I generate the valueBox in the UI, wrap the subtitle in a div, and successfully add a tooltip. But in Value 1, I generate the valueBox in the server, try to use the same approach of wrapping the subtitle in div, but no tooltip appears!

# Load required packages
library(shinydashboard)
library(shinyBS)

# Define UI
ui <- dashboardPage(
  dashboardHeader(title = "Simple Dashboard"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "dashboard",
              fluidRow(
                div(id = "box1",
                    box(
                  title = "Value 1",
                  valueBoxOutput("valueBox1"),
                  div(id = "textbox1", textOutput("text1"))
                )),
                bsTooltip(id = "valbox1", "Not working"),
                bsTooltip(id = "textbox1", "Working as expected"),
              ),
              fluidRow(
                div(id = "box2",
                    box(
                      title = "Value 2",
                      valueBox(32,
                               div(id = "valbox2", "Value 2")),
                      div(id = "textbox2", textOutput("text2"))

                    )),
                bsTooltip(id = "valbox2", "Working as expected"),
                bsTooltip(id = "textbox2", "Working as expected"),
                
              ),
              fluidRow(
                box(
                  actionButton("testButton", "TEST")
                )
              ),
              bsTooltip(id = "testButton", "Working as expected")
      )
    )
  )
)

# Define server
server <- function(input, output, session) {
  # Generate dummy data
  data <- data.frame(
    Value1 = sample(1:100, 1)
  )
  
  # Update value boxes when the action button is clicked
  observeEvent(input$testButton, {
    data$Value1 <- sample(1:100, 1)
    output$valueBox1 <- renderValueBox({
      valueBox(data$Value1,
               div(id = "valbox1", "Value 1"))
    })
    output$text1 <- renderText({
      "More info on Value 1"
    })
  })
  
  output$text2 <- renderText({
    "More info on Value 2"
  })
}

# Run the app
shinyApp(ui = ui, server = server)

I am unclear why adding the div() wrapper to the subtitle within the server is not working, when it works perfectly when I use this approach to add a wrapper in the UI.

I've already reviewed this question which shows how to add a tooltip to the entire valuebox, rather than specifically the subtitle, which is my issue.

Any help gladly received! My full application requires me to dynamically generate the valueBoxes in the server, because they can differ in number and content depending on user input - hence my need to generate in the server.

One way to overcome your issue is to use renderUI to output valueBoxOutput() on the server side. Try this

# Load required packages
library(shinydashboard)
library(shinyBS)
# Define UI
ui <- dashboardPage(
dashboardHeader(title = "Simple Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
fluidRow( uiOutput("v1")
# div(id = "box1",
#     box(
#       title = "Value 1",
#       valueBoxOutput("valueBox1"),
#       div(id = "textbox1", textOutput("text1"))
#     )),
# bsTooltip(id = "valbox1", "Not working"),
# bsTooltip(id = "textbox1", "Working as expected")
),
fluidRow(
div(id = "box2",
box(
title = "Value 2",
valueBox(32,
div(id = "valbox2", "Value 2")),
div(id = "textbox2", textOutput("text2"))
)),
bsTooltip(id = "valbox2", "Working as expected"),
bsTooltip(id = "textbox2", "Working as expected")
),
fluidRow(
box(
actionButton("testButton", "TEST")
)
),
bsTooltip(id = "testButton", "Working as expected")
)
)
)
)
# Define server
server <- function(input, output, session) {
# Generate dummy data
myvalue <- eventReactive(input$testButton, {
sample(1:100, 1)
})
output$valueBox1 <- renderValueBox({
valueBox(myvalue(), 
div(id = "valbox1", "Value 1"))
})
output$v1 <- renderUI({
req(myvalue())
tagList(
div(id = "box1",
box(
title = "Value 1",
valueBoxOutput("valueBox1"),
div(id = "textbox1", textOutput("text1"))
)),
bsTooltip(id = "valbox1", "Working as expected?"),
bsTooltip(id = "textbox1", "Working as expected")
)
})
output$text1 <- renderText({
"More info on Value 1"
})
output$text2 <- renderText({
"More info on Value 2"
})
}
# Run the app
shinyApp(ui = ui, server = server)