ttffxxz1
10-23-2023, 04:47 AM
As a preface, I'm totally new to VBA and have been trying to use ChatGPT to help me get started.
I have a simple request. I'm trying to assign a macro to a button in Column I which collapses and expands the text in Column H.
The cell is a timeline of events formatted like this:
01/01 - this is update 1
02/01 - this is update 2
this is also part of update 2
etc
When I click on the button to collapse the cell, I want it to only show the most recent event - the text following the date in bold regardless of how many lines of text there are. Then when I click the button again I want the cell to expand and show the full timeline of events.
I was initially given this code by ChatGPT:
Sub ExpandCell()
Dim Button As Shape
Set Button = ActiveSheet.Shapes(Application.Caller)
Dim Cell As Range
Set Cell = Button.TopLeftCell.Offset(0, -1)
' Check if cell is expanded or collapsed
If Cell.EntireRow.RowHeight = 15 Then
Cell.EntireRow.AutoFit
Else
Cell.EntireRow.RowHeight = 15
End If
End Sub
The problem with this is it collapsed the cell to only the final line of text, which cuts off updates which cover multiple lines of text. So, I asked it to create me another version which collapsed the text to show everything after the date in bold. It gave me this:
Sub ExpandCell()
Dim Button As Shape
Set Button = ActiveSheet.Shapes(Application.Caller)
Dim Cell As Range
Set Cell = Button.TopLeftCell.Offset(0, -1)
Dim Text As String
Text = Cell.Value
Dim Lines() As String
Lines = Split(Text, Chr(10))
' Loop through the lines to find the bold text (indicating the start of the latest update)
Dim i As Integer
For i = UBound(Lines) To 0 Step -1
If Lines(i) Like "[0-9]/[0-9]:*" Then
Exit For
End If
Next i
' Set the height of the cell based on the location of the latest update
If i = UBound(Lines) Then
Cell.EntireRow.AutoFit
Else
Cell.EntireRow.RowHeight = Button.TopLeftCell.RowHeight
End If
End Sub
The problem I have now, is that the button doesn't work at all. When I click 'debug' it highlights this in yellow.
Set Button = ActiveSheet.Shapes(Application.Caller)
I don't understand why that part of the code is now problematic, when it was working fine in the previous code? I've tried all the obvious solutions of closing and restarting excel, ensuring its a shape that can be assigned a macro etc.
Please advise?
I have a simple request. I'm trying to assign a macro to a button in Column I which collapses and expands the text in Column H.
The cell is a timeline of events formatted like this:
01/01 - this is update 1
02/01 - this is update 2
this is also part of update 2
etc
When I click on the button to collapse the cell, I want it to only show the most recent event - the text following the date in bold regardless of how many lines of text there are. Then when I click the button again I want the cell to expand and show the full timeline of events.
I was initially given this code by ChatGPT:
Sub ExpandCell()
Dim Button As Shape
Set Button = ActiveSheet.Shapes(Application.Caller)
Dim Cell As Range
Set Cell = Button.TopLeftCell.Offset(0, -1)
' Check if cell is expanded or collapsed
If Cell.EntireRow.RowHeight = 15 Then
Cell.EntireRow.AutoFit
Else
Cell.EntireRow.RowHeight = 15
End If
End Sub
The problem with this is it collapsed the cell to only the final line of text, which cuts off updates which cover multiple lines of text. So, I asked it to create me another version which collapsed the text to show everything after the date in bold. It gave me this:
Sub ExpandCell()
Dim Button As Shape
Set Button = ActiveSheet.Shapes(Application.Caller)
Dim Cell As Range
Set Cell = Button.TopLeftCell.Offset(0, -1)
Dim Text As String
Text = Cell.Value
Dim Lines() As String
Lines = Split(Text, Chr(10))
' Loop through the lines to find the bold text (indicating the start of the latest update)
Dim i As Integer
For i = UBound(Lines) To 0 Step -1
If Lines(i) Like "[0-9]/[0-9]:*" Then
Exit For
End If
Next i
' Set the height of the cell based on the location of the latest update
If i = UBound(Lines) Then
Cell.EntireRow.AutoFit
Else
Cell.EntireRow.RowHeight = Button.TopLeftCell.RowHeight
End If
End Sub
The problem I have now, is that the button doesn't work at all. When I click 'debug' it highlights this in yellow.
Set Button = ActiveSheet.Shapes(Application.Caller)
I don't understand why that part of the code is now problematic, when it was working fine in the previous code? I've tried all the obvious solutions of closing and restarting excel, ensuring its a shape that can be assigned a macro etc.
Please advise?