Sub Popup_FullPut(rngMst As Range, Optional strUnit As String) Dim r As Range Dim i As Long, j As Long, k As Long With CommandBars.Add(Position:=msoBarPopup) For i = 0 To rngMst.Rows.Count - 1 Set r = rngMst.Offset(0, 0).Resize(1, 1).Offset(i, 0) If r.Value = "" Then Exit For With .Controls.Add(msoControlPopup) .Caption = r.Value For j = 0 To rngMst.Rows.Count - 1 Set r = rngMst.Offset(0, 1).Resize(1, 1).Offset(j, 0) If r.Value = "" Then Exit For With .Controls.Add(msoControlPopup) .Caption = r.Value For k = 0 To rngMst.Rows.Count - 1 Set r = rngMst.Offset(0, 2).Resize(1, 1).Offset(k, 0) If r.Value = "" Then Exit For With .Controls.Add(msoControlButton) .Caption = r.Value & strUnit .OnAction = MkAction( "Popup_Input", rngMst.Address(external:=True),i & "|" & j & "|" & k ) End With Next End With Next End With Next .ShowPopup .Delete End With End Sub