Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help fixing a very ugly procedure
OK Jim;
Here is the code I wrote. It is embarassing to share but done nonetheless. Sorry it took me a day to reply. Sub DynValidList() ' Procedure setup commands On Error GoTo DynValidList_Error Application.Volatile False Worksheets("Member_List").Activate ' Declare Variables Dim DynList() As String Dim RowCount As Long Dim PikCol As Long Dim PikRow As Long Dim NumAryItems As Long Dim NumAryBlanks As Long ' Initiate Variables ' Read "Role_Choice" (Name range) into DynList array NumAryItems = Range("Role_Choice").Count ReDim DynList(NumAryItems) As String Dim i As Long For i = 1 To NumAryItems Step 1 DynList(i) = Range("Role_Choice").Cells(i, 1) Next i ' Allow 7 rows for Header at start of picked items column; ' add 1 to get fist row of Picked Roles -- Fix PikRow PikRow = Range("Col_Lables_Row").Row + 1 PikCol = 0 PikCol = ActiveCell.Column RowCount = Range("Member_LNames").Rows.Count NumAryBlanks = 0 ' Set up array of already picked items by removing picked items ' from the DynList Array replacing items with ("") blanks. Dim LineInDyn As Long LineInDyn = 0 For i = 0 To RowCount Step 1 If Trim(ActiveSheet.Cells(PikRow + i, PikCol).Value) < "" Then LineInDyn = WorksheetFunction.Match(ActiveSheet _ .Cells(PikRow + i, PikCol).Value, Range("Role_Choice"), 0) DynList(LineInDyn) = "" End If Next i ' Remove Blanks from interior of DynList Array by placing ' blanks at the end of the Array by shuffling all items upward. Dim j As Long Dim k As Long For j = 1 To NumAryItems Step 1 If DynList(j) = "" Then k = 0 Do Until j + k = NumAryItems Or DynList(j + k) < "" k = k + 1 Loop DynList(j) = DynList(j + k) DynList(j + k) = "" End If Next j ' Resize the DynList Array to remove blanks at the bottom. For i = 1 To NumAryItems Step 1 If DynList(i) = "" Then _ NumAryBlanks = NumAryBlanks + 1 Next i ' Dynamically resize drop down list/Range NumAryItems = NumAryItems - NumAryBlanks ReDim Preserve DynList(NumAryItems) Names.Add Name:="Flex_Role", _ RefersTo:=Range("Flex_Role").Resize(NumAryItems + 1, 1) Range("Empty_Role").Value = _ Application.WorksheetFunction.Transpose(DynList) ' Clean up bottom of Options Offical Roles range - "Empty_Role" For i = (NumAryItems + 2) To Range("Empty_Role").Rows.Count If WorksheetFunction.IsNA(Range("Empty_Role").Cells(i , 1)) Then _ Range("Empty_Role").Cells(i, 1) = "" Next i Exit Sub DynValidList_Error: If Err.Number = 1004 Then Resume Next Else MsgBox "Error " & Err.Number & " (" & Err.Description & ")in procedure DynValidList of Module MembInputMod" End If End Sub "Jim Jackson" wrote: Bill, Send us some of your code so we can know how to help. -- Best wishes, Jim "Bill Case" wrote: Hi; I have written a procedure that works; but it is long, convoluted and probably unstable i.e. ugly. I am looking for help writting a more appropriate set of code. Problem: Out of a large spreadsheet I have six columns that contain jobs to be filled by people. Each column represents a different date, so the procedure must start over at the beginning for each date/column. I want to use the Valitation drop down in the cells below the label for each column. I have a list of jobs which can vary from time-to-time on a separate worksheet but same workbook. The list of jobs is about 10 items long. As the user activates each cell a list of jobs that need to be done should dropdown showing the jobs left to be fulfilled. That is, as each job is assigned the dropdown should show the list in a particular column but with the jobs already assigned removed. I assume that this means the pick list (validation dropdown) has to be recalculated as to column/date and as to which jobs are available for each column. As I said, I have a procedure that works, but I suspect I am not making full use of VBA and/or formulas. Any guidance gratefully accepted. Regards Bill |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Ugly Problem | Excel Discussion (Misc queries) | |||
Filter (do not want the ugly drop-down button) | New Users to Excel | |||
Ugly file import into Excel | Excel Programming | |||
6E+02 what is this ugly scientific format? | Excel Programming |