IF "complete lines of cells are selected" Then

[Greg_Bxl]

Hi everyone,

I have a database on excel, with 27 fields. I need to create a macro that runs if at least those 27 field are selected. So if the entire row is selected, it should work too. I'm having a problem in writing the condition, the IF statement...
I already did something but it won't run if entire rows are selected. Why ? I have no idea ! Check this :

Copy this macro into the folder ThisWorkbook of a new workbook :

'This macro creates a new command in the popupmenu when
'right-clicking on a selected range, only if the range goes
'at least from column A (1) to column AA (27)
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim CellDropDown As CommandBar
Dim MyDropDownItem As CommandBarControl
column1 = Selection.Column 'number of the first column of the range
column2 = Selection.Columns(Selection.Columns.Count).Column 'number of the last column of the range
If column1 = 1 And column2 >= 27 Then
RemoveFromCellDropDown
Set CellDropDown = Application.CommandBars("Cell")
With CellDropDown.Controls.Add(Type:=msoControlButton, temporary:=True)
.Caption = "Archiving"
.Style = msoButtonIconAndCaption
.FaceId = 292
.OnAction = ThisWorkbook.Name & "!My_macro"
.Tag = "MyDropDownItem"
End With
End If
End Sub

Now, copy those two macros in a module

Public column1, column2 As Integer
'To remove the new command, use this macro + F5
Sub RemoveFromCellDropDown()
Dim MyDropDownItem As CommandBarControl
Set MyDropDownItem = Application.CommandBars.FindControl(Tag:="MyDropDownItem")
If Not MyDropDownItem Is Nothing Then
MyDropDownItem.Delete
End If
Set MyDropDownItem = Nothing
End Sub

'The main macro
'This one shows you the values of the variables used
'for the criteria of the IF statement
Sub My_macro()
MsgBox "The first column is : " & column1 & Chr(13) & "The last column is : " & column2
End Sub

Now, just go to your worksheet and select a few cells. Then right-click. If you select a small range, you get the regular popup menu. If the range goes from column A to at least column AA but NOT the entire row, you get a new command in the bottom of the popup menu and clicking on it shows you the values of the variables. Place the cursor on the macro RemoveFromCellDropDown to remove the new command.
Now, select entire rows and right-click. Nothing happens !
If you run "My_macro" with F5, you get Column1 = 1 and Column2 = 256 (which is greater than 27 !!!).
So why doesn't it work ?

I'm waiting for your answers.
Best regards.
Greg

 

[Greg_Bxl]

I found the solution !

Application.CommandBars("Cell") is used to indicate the dropdown menu when you rightclick on a range of cells. When the range is made of entire rows, the dropdown menu is not exactly the same. Its name is Application.CommandBars("Row").

This is the reviewed program. It runs perfectly. In My_macro, I will write something to cut and paste the selection in another sheet, for achiving.

Copy this in ThisWorkbook (in VBA) :

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim CellDropDown As CommandBar
Dim MyDropDownItem As CommandBarControl
Dim column1, column2 As Integer
RemoveFromDropDown
column1 = Selection.Column
column2 = Selection.Columns(Selection.Columns.Count).Column
If column1 = 1 And column2 >= 27 And column2 <> 256 Then
AddToCellDropDown
ElseIf column1 = 1 And column2 = 256 Then
AddToRowDropDown
End If
End Sub


Copy this in a module :


Dim CellDropDown As CommandBar
Dim MyDropDownItem As CommandBarControl

Set CellDropDown = Application.CommandBars("Cell")
With CellDropDown.Controls.Add(Type:=msoControlButton, temporary:=True)
.Caption = "Archiving"
.Style = msoButtonIconAndCaption
.FaceId = 292
.OnAction = ThisWorkbook.Name & "!My_macro"
.Tag = "MyDropDownItem"
End With
End Sub

Sub AddToRowDropDown()
Dim RowDropDown As CommandBar
Dim MyDropDownItem As CommandBarControl

Set RowDropDown = Application.CommandBars("Row")
With RowDropDown.Controls.Add(Type:=msoControlButton, temporary:=True)
.Caption = "Archiving"
.Style = msoButtonIconAndCaption
.FaceId = 292
.OnAction = ThisWorkbook.Name & "!My_macro"
.Tag = "MyDropDownItem"
End With
End Sub

Sub RemoveFromDropDown()
Dim MyDropDownItem As CommandBarControl
Set MyDropDownItem = Application.CommandBars.FindControl(Tag:="MyDropDownItem")
If Not MyDropDownItem Is Nothing Then
MyDropDownItem.Delete
End If
Set MyDropDownItem = Nothing
End Sub

Sub My_macro()
MsgBox "Hi there"
End Sub

Now, it works.
See you later.
Greg

 

[HalfAce]

Greg,
Good for you, getting your problem sorted out.
Especially good for you in posting your own solution for anyone else who runs across the same problem to see in the future.


Dan