I am currently building a macro that will create a Powerpoint from an excel workbook. I have two cells that I currently combine into one powerpoint textbox. I want to be able to bold one cell value in the textbox. Is this possible?
This is my current code:
Proj = Sheets("Bay du Nord").Range("A23")
Proj2 = Sheets("Bay du Nord").Range("B23")
Set LCProj = Slide2.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=210, Top:=265, Width:=110, Height:=100)
With LCProj
.Name = "LC Proj"
With .TextFrame.TextRange
.Text = Proj & vbNewLine & Proj2 & vbNewLine & "kg CO2/BOE"
.Font.Size = 12
.Font.Bold = False
.ParagraphFormat.Alignment = ppAlignCenter
End With
With .Fill
.TwoColorGradient msoGradientHorizontal, 2
.ForeColor.RGB = RGB(140, 0, 0)
.BackColor.RGB = RGB(180, 5, 0)
End With
.Shadow.Type = msoShadow14
End With
Say I want to bold the value that is in cell A23 (Proj) and leave the value in B23 (Proj2) the same.
Thanks
You can use TextRange.Characters() to change the properties of a subset of the original TextRange like so:
Proj = Sheets("Bay du Nord").Range("A23")
Proj2 = Sheets("Bay du Nord").Range("B23")
Set LCProj = Slide2.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=210, Top:=265, Width:=110, Height:=100)
With LCProj
.Name = "LC Proj"
With .TextFrame.TextRange
.Text = Proj & vbNewLine & Proj2 & vbNewLine & "kg CO2/BOE"
.Font.Size = 12
.Font.Bold = False
.ParagraphFormat.Alignment = ppAlignCenter
With .Characters(1, len(Proj))
.Font.Bold = True
End With
End With
With .Fill
.TwoColorGradient msoGradientHorizontal, 2
.ForeColor.RGB = RGB(140, 0, 0)
.BackColor.RGB = RGB(180, 5, 0)
End With
.Shadow.Type = msoShadow14
End With
Related
I have a problem to write working code in vba excell. I'm writing a form which saves clients on visits. When my code was in shorter version it worked good, but it doesnt find the cell based on column with hours and row with days in february. The longer code showed how i thought it could work. I also atach ss of table in excel and my userform with name, surname, sex, phone number, service type, day and hour. In table red color shows taken visits. When adding visits cell change color on pink/blue depending on cell.
Shorter code:
Private Sub CommandButton_Zatwierdz_Click()
Range("E8").Select
ActiveCell=TextBox_Name & " " & TextBox_Surname & Chr(10) & TextBox_PhoneNumber & Chr(10) & ComboBox_ServiceType
If OptionButton_Woman = True Then
ActiveCell.Interior.Color = RGB(255, 153, 204)
ElseIf OptionButton_Men = True Then
ActiveCell.Interior.Color = RGB(153, 204, 255)
ElseIf OptionButton_Woman = False And OptionButton_Men = False Then
MsgBox "You didn't choose a sex, choose a sex!"
Exit Sub
End If
End Sub
Longer code:
Private Sub CommandButton_Zatwierdz_Click()
Range("E8").Select
For ComboBox_Hour = Range("C9:C20").Find(what:=ComboBox_Hour).Select To ActiveCell = ""
For ComboBox_Day = Range("E7:AF7").Find(what:=ComboBox_Day).Select To ActiveCell = ""
If ActiveCell.Interior.Color = RGB(255, 0, 0) Then
MsgBox "Sorry, this time is taken, please choose another"
ElseIf ActiveCell.Interior.TintAndShade = 0.599993896298105 Then
' here i was trying to get this color, but probably wrong
' With Selection.Interior
' .Pattern = xlSolid
' .PatternColorIndex = xlAutomatic
' .ThemeColor = xlThemeColorAccent6
' .TintAndShade = 0.599993896298105
' .PatternTintAndShade = 0
'End With
ActiveCell=TextBox_Name & " " & TextBox_Surname & Chr(10) & TextBox_PhoneNumber & Chr(10) & ComboBox_ServiceType
If OptionButton_Woman = True Then
ActiveCell.Interior.Color = RGB(255, 153, 204)
ElseIf OptionButton_Men = True Then
ActiveCell.Interior.Color = RGB(153, 204, 255)
ElseIf OptionButton_Woman = False And OptionButton_Men = False Then
MsgBox "You didn't choose a sex, choose a sex!"
Exit Sub
End If
MsgBox "Your visit is now scheduled"
Exit Sub
End Sub
You don't need to use Find, calculate the cell position as an offset from the corner cell E8 Set cell = Range("E8").Offset((hr - 10) * 3, dy - 1)
Option Explicit
Private Sub CommandButton_Zatwierdz_Click()
Const TBL = "E8" ' day 1 10:00
Dim colorM As Long, colorF As Long
Dim colorCell As Long
colorM = rgb(153, 204, 255) ' blue
colorF = rgb(255, 153, 204) ' pink
' check valid data
If OptionButton_Woman = True Then
colorCell = colorF
ElseIf OptionButton_Men = True Then
colorCell = colorM
Else
MsgBox "You didn't choose a sex, choose a sex!"
Exit Sub
End If
Dim dy As Long, hr As Long, cell As Range, c As Long
' day
dy = CLng(ComboBox_day)
hr = Val(ComboBox_hour)
Set cell = Range(TBL).Offset((hr - 10) * 3 / 2, dy - 1)
MsgBox "hr=" & hr & " dy=" & dy & vbLf & "cell=" & cell.Address(0, 0, xlA1, True)
c = cell.Interior.Color
If c = colorM Or c = colorF Then
MsgBox "Sorry, this time is taken, please choose another"
Else
cell.Value = TextBox_Name & " " & TextBox_surname & vbLf & _
TextBox_PhoneNumber & vbLf & ComboBox_ServiceType
cell.Interior.Color = colorCell
MsgBox "Your visit is now scheduled", vbInformation, cell.Address
End If
End Sub
I'be built a code for a calendar-type plan with textboxes and pictures. I've managed to make a code so the shapes are all placed on the right spot. However, I'm struggling to copy some pictures from one sheet to another.
Sub AddEvent2()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim i As Integer, shp As Shape, s, s2, v, t1, t2, t3, h, p, w, rgb1, rgbULP, rgbPULP, rgbSPULP, rgbXLSD, rgbALPINE, rgbJET, rgbSLOPS As String
For Each shp In Sheets("Calendar").Shapes
shp.Delete
Next shp
For i = 4 To 21
t1 = Sheets("AdminSheet").Cells(i, 30).Value 'Cell location on Calendar
s = Sheets("AdminSheet").Cells(i, 29).Value 'Naming the shapebox
w = Sheets("AdminSheet").Cells(i, 28).Value 'Supplier
p = Sheets("AdminSheet").Cells(i, 27).Value 'Product
t2 = Sheets("AdminSheet").Cells(i - 1, 30).Value 'Next Cell location on Calendar
v = Application.WorksheetFunction.Text(Sheets("AdminSheet").Cells(i, 24).Value, "hh:mm") & " " & _
Sheets("AdminSheet").Cells(i, 25).Value & Sheets("AdminSheet").Cells(i, 26).Value & " " & Sheets("AdminSheet").Cells(i, 27).Value 'Text in shapebox
rgbULP = rgb(177, 160, 199)
rgbPULP = rgb(255, 192, 0)
rgbSPULP = rgb(0, 112, 192)
rgbXLSD = rgb(196, 189, 151)
rgbALPINE = rgb(196, 215, 155)
rgbJET = rgb(255, 255, 255)
rgbSLOPS = rgb(255, 0, 0)
If s <> "" Then
Sheets("Calendar").Select
If i > 4 And t2 = t1 Then
s2 = Sheets("AdminSheet").Cells(i - 1, 29).Value 'Name of the added shapebox
h = Sheets("Calendar").Shapes.Range(Array(s2)).Height 'Height of the added shapebox
t3 = Sheets("Calendar").Shapes.Range(Array(s2)).Top 'Top of the added shapebox
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Sheets("Calendar").Range(t1).Left + 1.5, 3 + t3 + h, 209, 36.6).Select
Else
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Sheets("Calendar").Range(t1).Left + 1.5, Sheets("Calendar").Range(t1).Top + 3, 209, 36.6).Select
End If
With Selection
.Name = s
With .ShapeRange
.IncrementLeft 0
.IncrementTop 0
With .Fill
.Visible = msoTrue
If p = "ULP" Then
.ForeColor.rgb = rgbULP
ElseIf p = "PULP" Then
.ForeColor.rgb = rgbPULP
ElseIf p = "SPULP" Then
.ForeColor.rgb = rgbSPULP
ElseIf p = "XLSD" Then
.ForeColor.rgb = rgbXLSD
ElseIf p = "ALPINE" Then
.ForeColor.rgb = rgbALPINE
ElseIf p = "JET" Then
.ForeColor.rgb = rgbJET
ElseIf p = "SLOPS" Then
.ForeColor.rgb = rgbSLOPS
End If
.Transparency = 0
.Solid
End With
With .TextFrame2
.MarginLeft = 5.7
.MarginRight = 38.6
.AutoSize = msoAutoSizeShapeToFitText
With .TextRange.Font
.NameComplexScript = "Lucida Console"
.NameFarEast = "Lucida Console"
.Name = "Lucida Console"
.Size = 14
End With
.TextRange.Characters.Text = v
End With
End With
End With
Sheets("AdminSheet").Select
ActiveSheet.Shapes.Range(Array(w)).Select
Selection.Copy
Sheets("Calendar").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = w & s
Selection.Name = w & s
Sheets("Calendar").Shapes(w & s).Top = Sheets("Calendar").Shapes(s).Top + (Sheets("Calendar").Shapes(s).Height / 2) - (Sheets("Calendar").Shapes(w & s).Height / 2)
Sheets("Calendar").Shapes(w & s).Left = Sheets("Calendar").Shapes(s).Left + Sheets("Calendar").Shapes(s).Width - Sheets("Calendar").Shapes(w & s).Width
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
As you can see I'm very new to coding... Anyway, what I'm trying to do is to copy a pic named after "w" and paste it to the right side of the added Textbox (within the box - I guess the location would be textbox.left + textbox.width - pic.width but it doesn't work). I've tried recording it but it doesn't work for me. Any ideas?
*Edit - I updated the with the code I use for that task and the error I get. The location is wrong as well - they go outside the textbox...
I also struggle to understand how to change the fillcolor.RGB of the shape dynamically. I made it work with "if" statement but looks ugly. Any ideas how to sort the code there? Why .ForeColor.RGB = "rgb" & p not working?
Thanks in advance
I found the problem.
On the initial code, the name of the picture I was copying was not changing, hence not unique on the Sheet. So, when I was tying to move the Shape("example"), I was moving all with the same name.
Anyway, code updated with name change variable!
Hi i am making a organisational hierarchy chart and i want to have a textbox below each nodes. What i did until now was to retrieve the data and plot out the hierarchy. But how do i add textbox under them? I have to add 2 textboxes below each nodes. Any help will be appreciated!
Code:
Option Explicit
Sub OrgChart()
Dim ogSALayout As SmartArtLayout
Dim QNodes As SmartArtNodes
Dim QNode As SmartArtNode
Dim ogShp As Shape
Dim shp As Shape
Dim t As Long
Dim i As Long
Dim r As Long
For Each shp In ActiveSheet.Shapes
If shp.Type = msoSmartArt Then: shp.Delete
Next shp
Set ogSALayout = Application.SmartArtLayouts( _
"urn:microsoft.com/office/officeart/2009/3/layout/HorizontalOrganizationChart" _
)
Set ogShp = ActiveSheet.Shapes.AddSmartArt(ogSALayout, 630, 36, 1000, 1000)
Set QNodes = ogShp.SmartArt.AllNodes
t = QNodes.Count
For i = 2 To t: ogShp.SmartArt.Nodes(1).Delete: Next i
Set QNode = QNodes(1)
If Range("D1").Value = "CONFIRM" Then
QNode.Shapes.Fill.ForeColor.RGB = RGB(255, 0, 0)
ElseIf Range("D1").Value = "PENDING" Then
QNode.Shapes.Fill.ForeColor.RGB = RGB(128, 128, 128)
ElseIf Range("D1").Value = "SUSPECTED" Then
QNode.Shapes.Fill.ForeColor.RGB = RGB(255, 255, 0)
ElseIf Range("D1").Value = "NO" Then
QNode.Shapes.Fill.ForeColor.RGB = RGB(0, 255, 0)
End If
With QNode.TextFrame2.TextRange
.Text = Range("B1").Value
.Font.Fill.ForeColor.RGB = vbBlack
.Font.Size = 12
.Font.Bold = True
End With
With QNode.Shapes.AddTextbox(msoTextOrientationHorizontal, _
100, 100, 200, 50) _
.TextFrame.Characters.Text = "Test Box"
End With
r = 1
Call AddChildren(QNode, r)
ogShp.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
End Sub
Sub AddChildren(ByVal QParent As SmartArtNode, ByVal r As Long)
Dim QChild As SmartArtNode
Dim Level As Long
Dim s As Long
Const MyCol As String = "C"
Level = Range(MyCol & r).Value
s = r + 1
Do While Range(MyCol & s).Value > Level
If Range(MyCol & s).Value = Level + 1 Then
Set QChild = QParent.AddNode(msoSmartArtNodeBelow)
If Range("D" & s).Value = "CONFIRM" Then
QChild.Shapes.Fill.ForeColor.RGB = RGB(255, 0, 0)
ElseIf Range("D" & s).Value = "PENDING" Then
QChild.Shapes.Fill.ForeColor.RGB = RGB(128, 128, 128)
ElseIf Range("D" & s).Value = "SUSPECTED" Then
QChild.Shapes.Fill.ForeColor.RGB = RGB(255, 255, 0)
ElseIf Range("D" & s).Value = "NO" Then
QChild.Shapes.Fill.ForeColor.RGB = RGB(0, 255, 0)
End If
With QChild.TextFrame2.TextRange
.Text = Range("B" & s).Value
.Font.Fill.ForeColor.RGB = vbBlack
.Font.Size = 12
End With
Call AddChildren(QChild, s)
End If
s = s + 1
Loop
End Sub
This is what it looks like now:
Edit: Added screenshot of data layout.
Adding a textbox under a node would mean that you would have to move the node up to make room for the textbox. As far as I know, it's not possible to move the nodes using VBA.
As a workaround, you could create another node under each node and format it as a textbox.
The outcome would look something like this:
To do this, I would first remove this from OrgChart
With QNode.Shapes.AddTextbox(msoTextOrientationHorizontal, _
100, 100, 200, 50) _
.TextFrame.Characters.Text = "Test Box"
End With
And replace it with:
Dim PseudoTxtBox As SmartArtNode
Set PseudoTxtBox = QNode.AddNode(msoSmartArtNodeAfter) 'Pseudo text box
'Add some text to the textbox
With PseudoTxtBox.TextFrame2.TextRange
.Text = "Some Text"
.Font.Fill.ForeColor.RGB = vbBlack
.Font.Size = 12
End With
'Make the textbox background transparent
PseudoTxtBox.Shapes.Fill.Transparency = 1
Then I would insert the following code right after adding the node in AddChildren :
Dim PseudoTxtBox As SmartArtNode
Set PseudoTxtBox = QChild.AddNode(msoSmartArtNodeAfter) 'Pseudo text box
'Add some text to the textbox
With PseudoTxtBox.TextFrame2.TextRange
.Text = "Some Text"
.Font.Fill.ForeColor.RGB = vbBlack
.Font.Size = 12
End With
'Make the textbox background transparent
PseudoTxtBox.Shapes.Fill.Transparency = 1
'Get the parent shape
Dim mshp As Shape
Dim tempObject As Object
Set tempObject = QChild.Parent
Do While TypeName(tempObject) <> "Shape"
Set tempObject = tempObject.Parent
Loop
Set mshp = tempObject
'Set the corresponding connector (line) to be transparent.
mshp.GroupItems(Level).Line.Transparency = 1
I would like a textbox like this in my Excel spreadsheet:
I used this query: VBA Shapes.AddTextbox Method
I modified the code:
Sub asbuiltstamp()
Set myDocument = Worksheets(1)
myDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
800, 50, 200, 75) _
.TextFrame.Characters.Text = "City Fibre As-Built"
.Font.ColorIndex = 3
.Font.Size = 20
.Font.HorizontalAlignment = xlCenter
.Shapes.Rotation = 45
.Shapes.Fill = False
End Sub
I get:
Compile error: Invalid or unqualified reference.
How can I customise my textbox with VBA Excel?
How can I set its own name (other than "Textbox1")?
You've tried to access several properties without specifying what they are properties of. You need something like this:
Sub asbuiltstamp()
Set myDocument = Worksheets(1)
With myDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 800, 50, 200, 75)
With .TextFrame
.HorizontalAlignment = xlCenter
With .Characters
.Text = "City Fibre" & vbLf & "As-Built"
With .Font
.Bold = True
.ColorIndex = 3
.Size = 20
End With
End With
End With
.Rotation = 45
.Fill.Visible = False
End With
End Sub
The immediate objective is to be able to group two shapes into a grouping ao they can be dragged around together. I have created both shapes but when the code runs the shapes are still not grouped I am relatively new to vba so im sure I am using some functionality incorrectly. This is the immediate code which I tried:
'Group the two boxes together
Dim ShapeArray As Variant
ShapeArray(0) = Box1.Name
ShapeArray(1) = ActiveShape.Name
ActiveSheet.Shapes.Range(ShapeArray(0, 1)).Group
The Full module code for context is as follows:
Sub Button2_Click()
Dim ActiveShape As Shape
Dim UserSelection As Variant
'Pull-in what is selected on screen
Set UserSelection = ActiveWindow.Selection
'Determine if selection is a shape
On Error GoTo NoShapeSelected
Set ActiveShape = ActiveSheet.Shapes(UserSelection.Name)
On Error Resume Next
'Do Something with your Shape variable
With ActiveShape.line 'Add border
.Weight = 5
.ForeColor.RGB = RGB(21, 2, 191)
End With
'Create a Shape inside the shape
Dim Box1 As Shape
Dim tope
tope = ActiveShape.TOP
Set Box1 = Sheet1.Shapes.AddTextbox(msoTextOrientationHorizontal, ActiveShape.Left, tope, 10, 10)
Box1.Fill.ForeColor.RGB = RGB(40, 30, 166)
'Group the two boxes together
Dim ShapeArray As Variant
ShapeArray(0) = Box1.Name
ShapeArray(1) = ActiveShape.Name
ActiveSheet.Shapes.Range(ShapeArray(0, 1)).Group
temp1 = ActiveShape.TextFrame.Characters.Caption
If InStr(temp1, "In Prog") = 0 Then ' Add Text
selTxt = Split(temp1, Chr(10))
shp.OLEFormat.Object.Caption = selTxt(0) & " " & "In Prog"
For i = 1 To (UBound(selectText) - 1)
shp.OLEFormat.Object.Caption = selectText(i) & vbNewLine
Next i
ActiveShape.TextFrame.Characters.Caption = ActiveShape.TextFrame.Characters.Caption & vbNewLine & "In Prog"
End If
'Error Handler
NoShapeSelected:
MsgBox "You do not have a shape selected!"
End Sub
Basically after highlighting a box, you can press a button in excel which augments this box in several ways as shown by the comments (adds borders and a box inside the old one). I would like the newly created box to group with the old one or collapse in some way so it is easy to drag around. If there is another easier way to select both of these boxes I would love to hear the input. Also these two boxes are not found in select rows or column of cells and can be anywhere in the worksheet so I cant apply ranges. Thank you for any help you may provide. If any other clarification is required or I forgot something pertinent to the problem please don't hesitate to ask. Thanks to all in advance!
Edit: The rest of the code is as follows:
The Worksheet Code:
Option Explicit
Public alltxt As String
Private selectText() As String
Private Sub CommandButton1_Click()
UF1.Show
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws As Worksheet
Set ws = Target.Parent
Dim temp
Dim i
Dim shp As Shape
Dim line As Variant
For Each shp In ws.Shapes 'loop through all shapes
If shp.Type = msoShapeRectangle Then 'that are text boxes
'write the header cells into the text box
temp = shp.OLEFormat.Object.Caption
'OLEFormat.Object.Caption
If InStr(temp, "week") = 0 And InStr(temp, "In Prog") = 0 Then
shp.OLEFormat.Object.Caption = shp.OLEFormat.Object.Caption & vbNewLine & ws.Cells(4, shp.TopLeftCell.Column).Text & " - " & ws.Cells(4, shp.BottomRightCell.Column).Text
ElseIf InStr(temp, "week") And InStr(temp, "In Prog") Then
selectText = Split(temp, Chr(10))
shp.OLEFormat.Object.Caption = ""
For i = 0 To (UBound(selectText) - 3)
shp.OLEFormat.Object.Caption = shp.OLEFormat.Object.Caption & selectText(i) & vbNewLine
Next i
shp.OLEFormat.Object.Caption = shp.OLEFormat.Object.Caption & vbNewLine & ws.Cells(4, shp.TopLeftCell.Column).Text & " - " & ws.Cells(4, shp.BottomRightCell.Column).Text & vbNewLine & "In Prog"
ElseIf InStr(temp, "week") And InStr(temp, "In Prog") = 0 Then
selectText = Split(shp.OLEFormat.Object.Caption, Chr(10))
shp.OLEFormat.Object.Caption = ws.Cells(4, shp.TopLeftCell.Column).Text & " - " & ws.Cells(4, shp.BottomRightCell.Column).Text
For i = (UBound(selectText) - 1) To 0 Step -1
shp.OLEFormat.Object.Caption = selectText(i) & vbNewLine & shp.OLEFormat.Object.Caption
Next i
End If
End If
Next shp
End Sub
The Userform Code:
Private Sub UserForm_Initialize()
'fill combobox catagory
Me.cmbCAT.AddItem "L1U"
Me.cmbCAT.AddItem "L1L"
Me.cmbCAT.AddItem "IN"
Me.cmbCAT.AddItem "SC"
Me.cmbCAT.AddItem "GE"
Me.cmbCAT.AddItem "TE"
Me.cmbCAT.AddItem "ExD"
'fill combobox resources
Me.cmbResource.AddItem "Item1"
Me.cmbResource.AddItem "Item2"
End Sub
Private Sub btnSubmit_Click()
Dim wrks As Worksheet
Set wrks = ThisWorkbook.Sheets("Sheet1")
Dim typ As String
typ = cmbCAT.Text
Dim Box As Shape
Set Box = Sheet1.Shapes.AddShape(msoShapeRectangle, 100, 100, 200, 60)
'AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 60)
If typ = "L1U" Then
Box.Fill.ForeColor.RGB = RGB(255, 180, 18)
ElseIf typ = "L1L" Then
Box.Fill.ForeColor.RGB = RGB(147, 196, 22)
ElseIf typ = "SC" Then
Box.Fill.ForeColor.RGB = RGB(147, 196, 22)
ElseIf typ = "IN" Then
Box.Fill.ForeColor.RGB = RGB(255, 255, 70)
ElseIf cmbCAT = "GE" Then
Box.Fill.ForeColor.RGB = RGB(255, 173, 203)
ElseIf cmbCAT = "TE" Then
Box.Fill.ForeColor.RGB = RGB(114, 163, 255)
Else
Box.Fill.ForeColor.RGB = RGB(159, 2, 227)
End If
Box.TextFrame.Characters.Caption = tbSP & "-" & tbDROP & "." & cmbCAT & "." & tbUS & vbNewLine & _
"Resource: " & cmbResource & vbNewLine & _
"Description: " & tbDES & vbNewLine
Unload UF1
End Sub
Try the following, the general syntax is Range(Array("shape1", "shape2")).Group
Dim ShapeArray(0 To 1) As String
ShapeArray(0) = Box1.Name
ShapeArray(1) = ActiveShape.Name
ActiveSheet.Shapes.Range(Array(ShapeArray(0), ShapeArray(1))).Group