The tab Test Sheet is the before and Test Sheet 2 is the after. I have a macro built (Sub InsertFormula) which inserts a column in D and copies all of the level 4's. Then create another column and uses TextJoin to create the join of all the level 4's at the 3rd level. This works fine, but it would be nice to create the textjoin without having to create the additional columns. Can it be constructed and placed in the comments straight from column C?
Code is attached in sample workbook.
Add WBS text to cell comment note
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Add WBS text to cell comment note
You do not have the required permissions to view the files attached to this post.
-
- 2StarLounger
- Posts: 151
- Joined: 11 Jun 2012, 20:37
Re: Add WBS text to cell comment note
try the following which includes the functionality of all your subs:
Code: Select all
Sub InsertFormula2()
Dim ws As Worksheet
Dim LastRow As Long
Dim myRow As Long
Dim myComment As String, NextRow As Long, x
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Test Sheet 3").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Sheets("Test Sheet").Copy After:=Worksheets(Sheets.Count): ActiveSheet.Name = "Test Sheet 3"
Set ws = Sheets("Test Sheet 3")
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
ws.UsedRange.ClearComments
For myRow = 2 To LastRow
If ws.Range("A" & myRow).Value = 3 Then
myComment = ""
NextRow = myRow + 1
Do Until ws.Range("A" & NextRow).Value <> 4
myComment = myComment & "(" & ws.Range("B" & NextRow).Value & ") " & ws.Range("C" & NextRow).Value & vbLf
NextRow = NextRow + 1
Loop
With ws.Range("C" & myRow)
.AddComment Left(myComment, Len(myComment) - 1)
With .Comment.Shape.TextFrame.Characters.Font
.Name = "Arial Nova Light"
.Size = 12
End With
.Comment.Shape.TextFrame.AutoSize = True
End With
End If
'indent:
x = ws.Range("A" & myRow).Value
Select Case x
Case 2 To 4: ws.Range("B" & myRow).Resize(, 2).IndentLevel = x - 1
End Select
Next myRow
Application.ScreenUpdating = True
End Sub
Last edited by p45cal on 17 Nov 2023, 19:42, edited 2 times in total.
-
- Administrator
- Posts: 78595
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Add WBS text to cell comment note
Staying closer yo your code:
Code: Select all
Sub InsertFormula()
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Test Sheet 2").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Sheets("Test Sheet").Copy After:=Worksheets(Sheets.Count): ActiveSheet.Name = "Test Sheet 2"
Dim ws As Worksheet: Set ws = Sheets("Test Sheet 2")
Dim LastRow As Long: LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Dim myRow As Long
Const MyCol As String = "D"
Application.ScreenUpdating = False
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
ws.UsedRange.ClearComments
Call CreateComments
Call AddIndent
Application.ScreenUpdating = True
End Sub
Sub CreateComments()
Dim LastRow As Long, r As Long
Dim s As String
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For r = LastRow To 2 Step -1
Select Case Range("A" & r).Value
Case 3
Range("C" & r).AddComment Mid(s, 3)
With Range("C" & r).Comment.Shape.TextFrame
With .Characters.Font
.Name = "Arial Nova Light"
.Size = 12
End With
.AutoSize = True
End With
s = ""
Case 4
s = s & vbCrLf & Range("B" & r).Value & " " & Range("C" & r).Value
End Select
Next r
End Sub
Public Sub AddIndent()
Const MyCol As String = "B"
Const StartRow As Long = 2
Dim myRow As Long
Dim x As Long
With Sheets("Test Sheet 2")
Dim LastRow As Long: LastRow = .Range(MyCol & .Rows.Count).End(xlUp).Row
For myRow = StartRow To LastRow
x = .Range("A" & myRow).Value
Select Case x
Case 2: .Range(MyCol & myRow).Resize(, 2).IndentLevel = 1
Case 3: .Range(MyCol & myRow).Resize(, 2).IndentLevel = 2
Case 4: .Range(MyCol & myRow).Resize(, 2).IndentLevel = 3
End Select
Next myRow
End With
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Re: Add WBS text to cell comment note
Thank you to you both. These are both great options.
@Hans, with your code, the string results in the comment are inverted. Also, I simply can't understand what the Mid(s, 3) is doing?
@Hans, with your code, the string results in the comment are inverted. Also, I simply can't understand what the Mid(s, 3) is doing?
-
- 4StarLounger
- Posts: 587
- Joined: 14 Nov 2012, 16:06
Re: Add WBS text to cell comment note
Code: Select all
Sub M_snb()
sn = Sheet3.Cells(1).CurrentRegion
With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
sn(j, 2) = Space(2 * sn(j, 1)) & sn(j, 2)
sn(j, 3) = Space(2 * sn(j, 1)) & sn(j, 3)
If sn(j, 1) = 3 Then c00 = Trim(sn(j, 3))
If sn(j, 1) = 4 Then .Item(c00) = .Item(c00) & vbLf & "(" & Trim(sn(j, 2)) & ") " & Trim(sn(j, 3))
Next
For j = 1 To UBound(sn)
If sn(j, 1) = 3 Then Sheet1.Cells(j, 3).AddComment Mid(.Item(Trim(sn(j, 3))), 2)
Next
End With
Sheet1.Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
End Sub
-
- Administrator
- Posts: 78595
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Add WBS text to cell comment note
This should return the correct order.
The Mid(s, 3) in the previous version and Left(s, Len(s) - 2) in the new one removes the extra carriage return/line feed from the string.
The Mid(s, 3) in the previous version and Left(s, Len(s) - 2) in the new one removes the extra carriage return/line feed from the string.
Code: Select all
Sub CreateComments()
Dim LastRow As Long, r As Long
Dim s As String
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For r = LastRow To 2 Step -1
Select Case Range("A" & r).Value
Case 3
Range("C" & r).AddComment Mid(s, 3)
With Range("C" & r).Comment.Shape.TextFrame
With .Characters.Font
.Name = "Arial Nova Light"
.Size = 12
End With
.AutoSize = True
End With
s = ""
Case 4
s = s & vbCrLf & Range("B" & r).Value & " " & Range("C" & r).Value
End Select
Next r
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Re: Add WBS text to cell comment note
Thanks Hans for the update, but this seems like the same code as before.
Thank you snb for your additional code.
Thank you snb for your additional code.
-
- Administrator
- Posts: 78595
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Add WBS text to cell comment note
Sorry, my mistake.
Code: Select all
Sub CreateComments()
Dim LastRow As Long, r As Long
Dim s As String
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For r = LastRow To 2 Step -1
Select Case Range("A" & r).Value
Case 3
Range("C" & r).AddComment Left(s, Len(s) - 2)
With Range("C" & r).Comment.Shape.TextFrame
With .Characters.Font
.Name = "Arial Nova Light"
.Size = 12
End With
.AutoSize = True
End With
s = ""
Case 4
s = Range("B" & r).Value & " " & Range("C" & r).Value & vbCrLf & s
End Select
Next r
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Re: Add WBS text to cell comment note
Thank you Hans for all of your time. Works great.