Replies

You could use the .OnKey method

Sub AssignUp_DownKeys()
    Application.OnKey "{down}", "IncrimentFormsListBoxSelection"
    Application.OnKey "{up}", "DecrimentFormsListBoxSelection"
End Sub

Sub IncrimentFormsListBoxSelection()
    With Sheets("Sheet1").Shapes("List Box 1").ControlFormat
        .ListIndex = ((.ListIndex) Mod .ListCount) + 1
    End With
End Sub

Sub DecrimentFormsListboxSelection()
    With Sheets("Sheet1").Shapes("List Box 1").ControlFormat
        .ListIndex = IIf(.ListIndex = 1, .ListCount, .ListIndex - 1)
    End With
End Sub

Sub Up_DownToNorma()
    Application.OnKey "{down}"
    Application.OnKey "{up}"
End Sub

I can’t text ActiveX controls on my Mac at home.
Once the code for one listbox had been vetted, one could be moved to a class module.
Each sheet’s Activate event could cause the appropriate controls to look to that class for their event code.

In a code module (named clsAllBoxes)

Public WithEvents aBox As msforms.ListBox

Private Sub aBox_Click()
    MsgBox "ListBox clicked"
End Sub

In a sheet’s code module

Private Sub Worksheet_Activate()
    Dim xBox As clsAllBoxes
    
    Set xBox = New clsAllBoxes
    Set xBox.aBox = ListBox1
    On Error Resume Next
        myBoxes.Add Item:=xBox, key:=Me.Name & xBox.Name
    On Error GoTo 0
    
    Set xBox = New clsAllBoxes
    Set xBox.aBox = ListBox2
    On Error Resume Next
        myBoxes.Add Item:=xBox, key:=Me.Name & xBox.Name
    On Error GoTo 0
    
End Sub

And the Public variable myBoxes is declared in a Normal Module

Public myBoxes as New Collection

There are four functions in that routine.
If none of them works for you, the idea is to concoct a string (formulaString) such that the formula

spareColumn.FormulaR1C1 = "=1/(1-(" & formulaString & ")"

will return an error value for those rows that you want deleted.

Merged cells get in the way of so many procedures that I prefer CenterAcrossSelection, when possible.

The attached routine will delete duplicated rows without looping. There are options for
delete all duplicated rows (Sam, Dave, Mary, Sam, John, Dave >> Mary, John)
keep first duplicated row, delete the rest (Sam, Dave, Mary, Sam, John, Dave >> Sam, Dave, Mary, John)
Delete all rows that match the name the user inputs
Keet the first row of the user input name, delete the other occurances.

For mass coloring, you could use Condiditonal Formatting.

Glad to have helped.
This might help to wade through the remaining 1/3:
Advanced Filter also will take pattern matching. If you have a two row, one column Criteria Range
Name
*John*

It will show all rows where “John” is a sub-string of the entry in the column that has “Name” as its header.

There are a couple of things you could do.
If the list in Tater!C6:Q1222 were sorted (on C), you could use VLOOKUP with 1 as the last argument to find an approximate match.

Another approach uses =TRIM(LEFT(TRIM($E7),FIND(CHAR(5),SUBSTITUTE(TRIM($E7),” “,CHAR(5),2)&CHAR(5)))) to turn E7’s “Smith, John A.” or “Smith, John Adam” into “Smith, John” (It takes everything before the second space (after trimming the double spaces down to single spaces)

Then =VLOOKUP(TRIM(LEFT(TRIM($E7),FIND(CHAR(5),SUBSTITUTE(TRIM($E7),” “,CHAR(5),2)&CHAR(5)))) & “*”, Tater!$C$6:$Q$1222, 8, False) will return a match for the first entry that begins with “Smith, John”. Note the use of the wildecard “*” in the VLOOKUP.

It will match with “Smith, John” or “Smith, John A” or “Smith, John Bob” or “Smith, Johnson and Kline”, which ever is first in Tater!C:C.

Put this formula in Sheet1 G2 and drag down
=INDEX(Sheet2!D:D,MATCH(“*”&SUBSTITUTE($B2,” “,”*”)&”*”,Sheet2!G:G,0),1)

It searches Sheet2’s Name column for the first entry that has both the first and last name from Sheet1’s User Full Name Column.

Another approach would be to create a Custom List from Sheet1 column B and use that list to sort Sheet2 (sort on G).
This should bring the matching rows of Sheet2 to the top of the sheet.

I notice that only one of the names on Sheet1 have a match on Sheet2.


With ActiveSheet.Cells.SpecialCells(xlCellTypeVisible)
If .Areas.Count = 1 Then
MsgBox "no columns are hidden"
Else
MsgBox .Areas(2).Column & " is the first visible column after the hidden columns."
End If
End With

There are a couple of other ways to do this.
These use the Application.InputBox method rather than the InputBox function. One difference between the two is that Application.InputBox can accept ranges input via mouse.

Sub HideColumnsChosenWithMouse()
Dim uiFirstColumn As Range
Dim uiLastColumn As Range

On Error Resume Next
Set uiFirstColumn = Application.InputBox("Select the first column with the mouse", Type:=8)
On Error GoTo 0
If uiFirstColumn Is Nothing Then Exit Sub: Rem cancel pressed

On Error Resume Next
Set uiLastColumn = Application.InputBox("Select the last column with the mouse", Type:=8)
On Error GoTo 0
If uiLastColumn Is Nothing Then Exit Sub: Rem cancel pressed

Range(uiFirstColumn, uiLastColumn).EntireColumn.Hidden = True
End Sub

The user typing in a column address requires validation, in case they type an invalid column name, like “Apple Pie”

Sub HideColumnsFromTypedAddresses()
Dim uiFirstCollAddress As Variant
Dim uiLastCollAddress As Variant
Dim EntryIsValidColumnAddress As Boolean

Do
uiFirstCollAddress = Application.InputBox("Enter the number/letter of the first hidden column.", Type:=7)
If uiFirstCollAddress = False Then MsgBox "x": Exit Sub: Rem cancel pressed
On Error Resume Next
EntryIsValidColumnAddress = (TypeName(Columns(uiFirstCollAddress)) = "Range")
On Error GoTo 0
Loop Until EntryIsValidColumnAddress

EntryIsValidColumnAddress = False

Do
uiLastCollAddress = Application.InputBox("Enter the number/letter of the last hidden column.", Type:=7)
If uiLastCollAddress = False Then MsgBox "x": Exit Sub: Rem cancel pressed
On Error Resume Next
EntryIsValidColumnAddress = (TypeName(Columns(uiLastCollAddress)) = "Range")
On Error GoTo 0
Loop Until EntryIsValidColumnAddress

Range(Columns(uiFirstCollAddress), Columns(uiLastCollAddress)).Hidden = True
End Sub

Or you could have the user select the whole range of columns to be hidden rather than specify start and end.

Sub HideColumnsInOneSwellFoop()
Dim uiRangeSelected

On Error Resume Next
Set uiRangeSelected = Application.InputBox("Select cells from all the columns you want hidden.", Type:=8)
On Error GoTo 0
If uiRangeSelected Is Nothing Then Exit Sub: Rem Cancel pressed

uiRangeSelected.EntireColumn.Hidden = True
End Sub

You don’t need to be as elaborate as that routine.
The key that I found is that when using the .NavigateArrows method, the ArrowNumber for all off-sheet precedents (dependents) is 1, so you only have to loop through the second index. Note that .NavigateArrows Selects the precedent (dependent) cell.
The routine in the link is basicaly this (plus bells&whistles and references to closed workbooks. (NavigateArrows only leads to open workbooks))

Do
i = i+1
sourceCell.NavigateArrows(True,1,i)
MsgBox ActiveCell.Address(,,,True) & " is a precedent of " & sourceCell.Address(,,,True)
Loop Until ActiveCell.Address(,,,True) = sourceCell.Address(,,,True)

If I recall correctly, the order that they appear will be their order in the formula (left to right).

Edit: Oh yeah, sourceCell.TracePrecedents before using .NavigateArrows. Its a screen intensive process, so Application.ScreenUpdating=False is a big time saver.

No, there isn’t an easy way to trace the off-sheet precedents of a formula.
This Link has a Sub (RunMe) that will show all the precedents (on and off sheet) of the Active Cell

If you run this code

Dim newWorkbook As Workbook, myFullFile As String

myFullFile = Application.GetOpenFilename

If myFullFile = "False" Then
Exit Sub: Rem Cancel pressed
Else
Set newWorkbook = Application.Workbooks.Add(myFullFile)
End If

It will prompt you to select a file and will create a duplicate of that file.

There are a couple of ways one could go with this.
You could put this in the sheets code module. (If the lay-out has changed from the attachment, ranges will need to be adjusted.)

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim altMenuMessage As String, altPrice As Double, altMenuItem As String
altMenuItem = "Chicken Strips with Chips"
altPrice = 3.29
altMenuMessage = "There is no child's menu avaliable." & vbCr
altMenuMessage = altMenuMessage & "Would you like to order the " & altMenuItem & " ("
altMenuMessage = altMenuMessage & Format(altPrice, "currency") & ")?"
With Target
If .Cells.Count = 1 And (.Column = 10 Or .Column = 12) Then
If .EntireRow.Range("I1").Value = "Lindsey" _
And .EntireRow.Range("J1")=vbNullString _
And .EntireRow.Range("L1")=vbNullString Then
If MsgBox(altMenuMessage, vbYesNo) = vbYes Then
.Value = altMenuItem
.Offset(0, 1) = altPrice: Rem Indicated line
End If
End If
End If
End With
End Sub

However, overwriting the formula in the price column makes changing Lindsey’s mind a problem.
What you could do about that is:

1) Put “Chicken Strips With Chips” in C8 and 3.29 in G8. Changing the font color to white in both cells will hide this. Since these cells are outside the range the Validation draws from, it won’t add Chicken Strips to the others’s menus.

2 ) Change the range in all the VLOOKUPS to =IF(J3>””,VLOOKUP(J3,$C$2:$G$17,5,FALSE),”0.00″). Since no Starter has the same name as a Main Course this would cause no problems.

3) Remove the Indicated Line from the VB routine.

I hope this helps.

I’m glad it worked for you.

Selecting and Copy/PasteSpecial is not needed, unless you want to go to the sheet horizontal.

With Selection
Sheets('horizontal").Range("A65536").End(xlup).Offset(1, 0).Resize(1,.Rows.Count).Value = Application.Transpose(.Value)
End With