Reordering part of a list with VBA

[omnicrondelicious]

I've got a handful of issues to work through with a particular project
I'm working on but let's start with the first: reordering part of a
list with VBA.

I have a list on a hidden tab (let's be adventurous and call it the
"List" tab) which prepopulates a drop-down list for data entry on
another tab (the "Entry" tab, shocking!). However, a user has the
option of entering a value not on the drop-down menu, if need be. I've
got a Worksheet_Change function that will append this new value to the
bottom of the list, which of course means it now appears on the drop-
down menu. So far, so good, except I would like to resort the list by
alpha after appending the new record.

"Aha! Easy!" you say, but not so fast. There's a catch - I always want
two values ("N/A" and "<Enter New Item>") to be at the very bottom of
the menu.

Sooooo, how do I take a list, append a record to it, and then resort
it, except the records that were formerly the last and second-to-last
- so as to keep them at the bottom of the new list? I can come up some
brilliantly convoluted ways of doing this, but hopefully there's
something simpler.

Thanks!

..o.

 

[JLatham]

Not knowing exactly how you're getting the new entry for the list and
where/how your current code to add to the list works, I've come up with this
code that you should be able to adapt and 'blend' with what you have now to
do the job.

Sub AddToList()
Const ListSheet = "List" ' change as needed
Const ListColumn = "E" ' change as needed
Dim NewItem As String
Dim lastUsedRow As Long
Dim SortKey As String
Dim StartSheet As String
Dim StartLocation As String

StartSheet = ActiveSheet.Name
StartLocation = ActiveCell.Address
' make actions invisible to user
Application.ScreenUpdating = False
Worksheets(ListSheet).Visible = True
Worksheets(ListSheet).Select

NewItem = "dale" ' or however else you get it

'find row# 1 row above last used row
lastUsedRow = Worksheets(ListSheet). _
Range(ListColumn & Rows.Count).End(xlUp). _
Offset(-1, 0).Select
Selection.Insert Shift:=xlDown
ActiveCell = NewItem

SortKey = ListColumn & "1"
Range(ListColumn & "1:" & ActiveCell.Address).Select
Selection.Sort Key1:=Range(SortKey), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Range(SortKey).Select ' for neatness
'back to original location
Worksheets(StartSheet).Select
Worksheets(ListSheet).Visible = False ' hide again
Range(StartLocation).Activate
Application.ScreenUpdating = True

End Sub

 

[omnicrondelicious]

Hey, this worked great, thanks! I encountered two unexpected issues
that maybe someone could shed some light on.

First up - I had another tab with cells that referred to the values on
the list sheet. When inserting a row, the other tab wouldn't update to
look for the additional row. e.g. on the other tab I've got cells that
say =List!A4 =List!A5 =List!A6, etc. When this macro inserts a row at
row 5 on the List sheet, my other tab now says =List!A4 =List!A5 =List!
A7, etc. To get around this, I dropped the insert row and just set the
values that I needed. But maybe there's another way?

Second - the sort function simply would not work unless I stored it as
a separate macro in a module and referred to it when updating the
list. What's going on there?

If it helps, here's the code I'm using. If snipped out a bunch of
extraneous If...Else stuff.

thanks,
..o.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim NewItem As String
Dim StartLocation As String

Set ws1 = Worksheets("School_List")
Set ws2 = Worksheets("Roster")

<SNIP>
Application.ScreenUpdating = False
StartLocation = Target.Address
NewItem = Target.Value
Target.Offset(0, 1).Formula = ""
Target.Offset(0, 2).Formula = ""
ws1.Select
ws1.Range("A" & Rows.Count).End(xlUp).Offset(-1, 0).Select
ActiveCell = NewItem
ActiveCell.Offset(0, 1).Formula = "=VLOOKUP(A" &
ActiveCell.Offset(0, 1).Row & ",'Roster'!$K$23:$M$105,2,FALSE)"
ActiveCell.Offset(0, 2).Formula = "=VLOOKUP(A" &
ActiveCell.Offset(0, 2).Row & ",'Roster'!$K$23:$M$105,3,FALSE)"
ActiveCell.Offset(1, 0).Value = "N/A"
ActiveCell.Offset(2, 0).Value = "<Enter New School>"
Sort_List
Range("A1").Select
ws2.Select
Range(StartLocation).Offset(0, 1).Activate
Application.ScreenUpdating = True
<SNIP>
End Sub

Sub Sort_List()

Range("A1:" & ActiveCell.Address).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

 

[JLatham]

Can you send me a copy of your current workbook with code you're using now?
I can tell more by working with it than I can here. An explanation of what
you've had to adjust on the worksheets (like where you had to change
references to other cells as =List!A7) would be helpful - could just add
comments in the cells or toss a textbox onto the sheet with explanation.

If you can, send as an email attachment to (remove all spaces)
Help From @ jlathamsite.com
if it's a really big file (3 or more MB) then consider zipping it up with
WinZip or WinRar if you don't mind.

JLatham