Expanding a range

[Oldjay]

I have the following code

Private Sub CommandButton1_Click() 'Extend range and sort project numbers

Application.ScreenUpdating = False 'Keeps screen from updating thereby
speeding
Application.DisplayAlerts = False 'code execution

Dim Project_Numbers As Range

Application.GoTo Reference:="Project_Numbers" 'Check to see if the first
record is blank
Range("A11").Select
If Range("A12") = "" Then
Range("A12").Select
End
Else

Set rng = Range("Project_Numbers")
rng.Resize(rng.Rows.Count + 1).Name = "Project_Numbers"
Selection.Sort Key1:=Range("A11"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Application.GoTo Reference:="Employee_Initials"

MainMenu.Show
End If
End Sub

This works fine if I am only adding one project at a time. but some times I
might add 2 or more projects

thanks in advance

oldjay

 

[NickHK]

Not entirely clear what you are doing.

Here you have a Range object
Dim Project_Numbers As Range
But do not set it to anything

But here you use (the Range ?) as a string value
Application.GoTo Reference:="Project_Numbers" 'Check to see if the first
record is blank

What does this achieve ?
Range("A11").Select

You should read the Help on using "End" and the consequences.
I doubt you need it. Possible "Exit Sub" instead.
If Range("A12") = "" Then
Range("A12").Select
End
End If

rng is not declared. Do you mean your Project_Numbers object above ?
Set rng = Range("Project_Numbers")

As for the multiple projects, I would guess you multiple named ranges.

Dim i as long

for i=1 to NumberOfProject 'From your own structure
Set rng = Range("Project_Numbers" & i)
'Do your stuff
next

NickHK

 

[Oldjay]

You think you were not clear about what I was doing. I really didn't know
what i needed
I had patched code from other places

I didn't need a variable database just a Vlookup

Private Sub CommandButton1_Click() 'Sort project numbers

Range("A11").Select

Selection.Sort Key1:=Range("A11"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Application.GoTo Reference:="Employee_Initials"

MainMenu.Show

End Sub

Thanks for making me think what I really needed

oldjay