PDA

View Full Version : Solved: Sorting Problem



coliervile
02-23-2008, 04:16 AM
In the following workbook I was making a "Dashboard", so to speak, to allow the user to perform various functions using buttons. The same buttons are on the worksheet named "Leave Request. When I click on the buttons "Quick Search For Leave By Date" and "Quick Search For Leave By Name" and execute them I run in to a sorting problem here:

Worksheets("Leave Request").Range("A:E").Sort _
Key1:=Range("B2"), Order1:=xlAscending, key2:=Range("D2"), Order2:=xlAscending, _
Header:=xlYes

This is the error message:

"""Run-time error '1004'

The sort reference is not valid. Make sure that it's within the data you want to sort, and the first Sort By box isn't the same or Blank."""


I don't get this problem when I use the buttons on the "Leave Request" worksheet. What am I missing or wrong with the sort from the "Dashboard" buttons???

Best regards,

Charlie

Bob Phillips
02-23-2008, 04:22 AM
With Worksheets("Leave Request")
.Range("A:E").Sort _
Key1:=.Range("B2"), Order1:=xlAscending, _
Key2:=.Range("D2"), Order2:=xlAscending, _
Header:=xlYes
End With

coliervile
02-23-2008, 04:32 AM
Thanks "xld" for responding. I put your coding in and I recieve the same error? Here's the whole coding:

Private Sub TextBox1_AfterUpdate()
Dim mpLastRow As Long
Dim mpRows As Variant
Dim mpNames As Range
Dim mpDatesStart As Range
Dim mpEndStart As Range
Dim mpTestDate As Date
Dim mpMessage As String
Dim i As Long

With Worksheets("Leave Request")
.Range("A:E").Sort _
Key1:=Range("B2"), Order1:=xlAscending, _
key2:=Range("D2"), Order2:=xlAscending, _
Header:=xlYes
End With

With Worksheets("Leave Request")

mpTestDate = CDate(Me.TextBox1.Text)
mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set mpDatesStart = .Range("D1").Resize(mpLastRow)
Set mpDatesEnd = .Range("E1").Resize(mpLastRow)
Set mpNames = .Range("A1").Resize(mpLastRow)

mpRows = .Evaluate("IF((" & mpDatesStart.Address & "<=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)*" & _
"(" & mpDatesEnd.Address & ">=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)," & _
"ROW(" & mpNames.Address & "))")
For i = LBound(mpRows) To UBound(mpRows)

If mpRows(i, 1) <> False Then

mpMessage = mpMessage & "Requested" & " " & mpTestDate & " " & "Off- " & " " & mpNames.Cells(i, 1).Value & _
" (Leave type: " & mpNames.Cells(i, 3).Value & _
", Requested on: " & mpNames.Cells(i, 2).Text & ")" & vbNewLine & vbNewLine

LastRowPrintout = Worksheets("Printout").Range("A" & Rows.Count).End(xlUp).Row
Rows(i).Copy Worksheets("Printout").Range("A" & LastRowPrintout + 1)

End If
Next i

If mpMessage <> "" Then

MsgBox mpMessage, vbOKOnly + vbInformation
Else

MsgBox "No Leave Request For This Date", vbOKOnly + vbInformation
End If

Worksheets("Leave Request").Range("A:E").Sort _
Key1:=Range("D2"), Order1:=xlAscending, key2:=Range("B2"), Order2:=xlAscending, _
Header:=xlYes

End With
End Sub

Best regards,

Charlie

Bob Phillips
02-23-2008, 04:44 AM
Private Sub TextBox1_AfterUpdate()
Dim mpLastRow As Long
Dim mpRows As Variant
Dim mpNames As Range
Dim mpDatesStart As Range
Dim mpEndStart As Range
Dim mpTestDate As Date
Dim mpMessage As String
Dim i As Long

With Worksheets("Leave Request")
.Range("A:E").Sort Key1:=Range("B2"), Order1:=xlAscending, _
Key2:=Range("D2"), Order2:=xlAscending, _
Header:=xlYes

mpTestDate = CDate(Me.TextBox1.Text)
mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set mpDatesStart = .Range("D1").Resize(mpLastRow)
Set mpDatesEnd = .Range("E1").Resize(mpLastRow)
Set mpNames = .Range("A1").Resize(mpLastRow)

mpRows = .Evaluate("IF((" & mpDatesStart.Address & _
"<=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)*" & _
"(" & mpDatesEnd.Address & ">=--""" & _
Format(mpTestDate, "yyyy-mm-dd") & """)," & _
"ROW(" & mpNames.Address & "))")

For i = LBound(mpRows) To UBound(mpRows)

If mpRows(i, 1) <> False Then

mpMessage = mpMessage & "Requested" & " " & mpTestDate & " " & _
"Off- " & " " & mpNames.Cells(i, 1).Value & _
" (Leave type: " & mpNames.Cells(i, 3).Value & _
", Requested on: " & mpNames.Cells(i, 2).Text & ")" & vbNewLine & vbNewLine

LastRowPrintout = Worksheets("Printout").Range("A" & Rows.Count).End(xlUp).Row
.Rows(i).Copy Worksheets("Printout").Range("A" & LastRowPrintout + 1)
End If
Next i

If mpMessage <> "" Then

MsgBox mpMessage, vbOKOnly + vbInformation
Else

MsgBox "No Leave Request For This Date", vbOKOnly + vbInformation
End If

.Range("A:E").Sort Key1:=.Range("D2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes
End With
End Sub

coliervile
02-23-2008, 04:55 AM
I now recieve a Compile error: Expected End With at the "End Sub"???

Private Sub TextBox1_AfterUpdate()
Dim mpLastRow As Long
Dim mpRows As Variant
Dim mpNames As Range
Dim mpDatesStart As Range
Dim mpEndStart As Range
Dim mpTestDate As Date
Dim mpMessage As String
Dim i As Long

With Worksheets("Leave Request")
.Range("A:E").Sort Key1:=Range("B2"), Order1:=xlAscending, _
Key2:=Range("D2"), Order2:=xlAscending, _
Header:=xlYes

mpTestDate = CDate(Me.TextBox1.Text)
mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set mpDatesStart = .Range("D1").Resize(mpLastRow)
Set mpDatesEnd = .Range("E1").Resize(mpLastRow)
Set mpNames = .Range("A1").Resize(mpLastRow)

mpRows = .Evaluate("IF((" & mpDatesStart.Address & _
"<=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)*" & _
"(" & mpDatesEnd.Address & ">=--""" & _
Format(mpTestDate, "yyyy-mm-dd") & """)," & _
"ROW(" & mpNames.Address & "))")

For i = LBound(mpRows) To UBound(mpRows)

If mpRows(i, 1) <> False Then

mpMessage = mpMessage & "Requested" & " " & mpTestDate & " " & _
"Off- " & " " & mpNames.Cells(i, 1).Value & _
" (Leave type: " & mpNames.Cells(i, 3).Value & _
", Requested on: " & mpNames.Cells(i, 2).Text & ")" & vbNewLine & vbNewLine

LastRowPrintout = Worksheets("Printout").Range("A" & Rows.Count).End(xlUp).Row
.Rows(i).Copy Worksheets("Printout").Range("A" & LastRowPrintout + 1)
End If
Next i

If mpMessage <> "" Then

MsgBox mpMessage, vbOKOnly + vbInformation
Else

MsgBox "No Leave Request For This Date", vbOKOnly + vbInformation
End If

With Worksheets("Leave Request")
.Range("A:E").Sort Key1:=Range("D2"), Order1:=xlAscending, _
Key2:=Range("B2"), Order2:=xlAscending, _
Header:=xlYes

End With
End Sub

By the way how are you today? Have a good one.

Best regards,

Charlie

Bob Phillips
02-23-2008, 05:01 AM
I thought I had corrected that before posting



Private Sub TextBox1_AfterUpdate()
Dim mpLastRow As Long
Dim mpRows As Variant
Dim mpNames As Range
Dim mpDatesStart As Range
Dim mpDatesEnd As Range
Dim mpTestDate As Date
Dim mpMessage As String
Dim LastRowPrintout As Long
Dim i As Long

With Worksheets("Leave Request")
.Range("A:E").Sort Key1:=Range("B2"), Order1:=xlAscending, _
Key2:=Range("D2"), Order2:=xlAscending, _
Header:=xlYes

mpTestDate = CDate(Me.TextBox1.Text)
mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set mpDatesStart = .Range("D1").Resize(mpLastRow)
Set mpDatesEnd = .Range("E1").Resize(mpLastRow)
Set mpNames = .Range("A1").Resize(mpLastRow)

mpRows = .Evaluate("IF((" & mpDatesStart.Address & _
"<=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)*" & _
"(" & mpDatesEnd.Address & ">=--""" & _
Format(mpTestDate, "yyyy-mm-dd") & """)," & _
"ROW(" & mpNames.Address & "))")

For i = LBound(mpRows) To UBound(mpRows)

If mpRows(i, 1) <> False Then

mpMessage = mpMessage & "Requested" & " " & mpTestDate & " " & _
"Off- " & " " & mpNames.Cells(i, 1).Value & _
" (Leave type: " & mpNames.Cells(i, 3).Value & _
", Requested on: " & mpNames.Cells(i, 2).Text & ")" & vbNewLine & vbNewLine

LastRowPrintout = Worksheets("Printout").Range("A" & Rows.Count).End(xlUp).Row
.Rows(i).Copy Worksheets("Printout").Range("A" & LastRowPrintout + 1)
End If
Next i

If mpMessage <> "" Then

MsgBox mpMessage, vbOKOnly + vbInformation
Else

MsgBox "No Leave Request For This Date", vbOKOnly + vbInformation
End If

.Range("A:E").Sort Key1:=Range("D2"), Order1:=xlAscending, _
Key2:=Range("B2"), Order2:=xlAscending, _
Header:=xlYes
End With
End Sub

coliervile
02-23-2008, 05:08 AM
Your not going to believe this, but I'm now getting the original error message at the same sort location...

"""Run-time error '1004'

The sort reference is not valid. Make sure that it's within the data you want to sort, and the first Sort By box isn't the same or Blank."""

I'm enclosing my workbook and the button "Quick Search For Leave By Date" is on the "Dashboard". I must be doing something wrong???

Best regards,

Charlie

mdmackillop
02-23-2008, 05:44 AM
You need to quailfy the Key ranges as you're working from a different sheet.
With Worksheets("Leave Request")
.Range("A:E").Sort _
Key1:=.Range("B2"), Order1:=xlAscending, Key2:=.Range("D2"), Order2:=xlAscending, _
Header:=xlYes
End With

coliervile
02-23-2008, 06:00 AM
Hello mdmackillop and thanks for your help too. Since I'm sorting the same worksheet twice in the same Private Sub would I have to do what you're suggesting twice and adjust the two columns a necessary?

To save time I tried the above (in blue text) and came across this "compile error...Invalid or Unqualified reference" (in red text). Very frustrating.

Private Sub TextBox1_AfterUpdate()
Dim mpLastRow As Long
Dim mpRows As Variant
Dim mpNames As Range
Dim mpDatesStart As Range
Dim mpDatesEnd As Range
Dim mpTestDate As Date
Dim mpMessage As String
Dim LastRowPrintout As Long
Dim i As Long

With Worksheets("Leave Request")
.Range("A:E").Sort _
Key1:=.Range("B2"), Order1:=xlAscending, Key2:=.Range("D2"), Order2:=xlAscending, _
Header:=xlYes
End With

mpTestDate = CDate(Me.TextBox1.Text)
mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set mpDatesStart = .Range("D1").Resize(mpLastRow)
Set mpDatesEnd = .Range("E1").Resize(mpLastRow)
Set mpNames = .Range("A1").Resize(mpLastRow)

mpRows = .Evaluate("IF((" & mpDatesStart.Address & _
"<=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)*" & _
"(" & mpDatesEnd.Address & ">=--""" & _
Format(mpTestDate, "yyyy-mm-dd") & """)," & _
"ROW(" & mpNames.Address & "))")

For i = LBound(mpRows) To UBound(mpRows)

If mpRows(i, 1) <> False Then

mpMessage = mpMessage & "Requested" & " " & mpTestDate & " " & _
"Off- " & " " & mpNames.Cells(i, 1).Value & _
" (Leave type: " & mpNames.Cells(i, 3).Value & _
", Requested on: " & mpNames.Cells(i, 2).Text & ")" & vbNewLine & vbNewLine

LastRowPrintout = Worksheets("Printout").Range("A" & Rows.Count).End(xlUp).Row
.Rows(i).Copy Worksheets("Printout").Range("A" & LastRowPrintout + 1)
End If
Next i

If mpMessage <> "" Then

MsgBox mpMessage, vbOKOnly + vbInformation
Else

MsgBox "No Leave Request For This Date", vbOKOnly + vbInformation
End If

With Worksheets("Leave Request")
.Range("A:E").Sort
Key1:=.Range("D2"), Order1:=xlAscending, Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes
End With
End With
End Sub

Best regards,

Charlie

mdmackillop
02-23-2008, 06:02 AM
Omit the "." this time!

coliervile
02-23-2008, 06:12 AM
At what location do I remove
Omit the "." this time!
.

Thanks for your time.

Best regards,

Charlie

mdmackillop
02-23-2008, 06:14 AM
Check your With statements as they are not consistent. Also, your posted code refers to a TextBox, Your form has a ComboBox. I'm getting confused.

coliervile
02-23-2008, 06:31 AM
I copied your suggestion of:




VBA:
With Worksheets("Leave Request") .Range("A:E").Sort _ Key1:=.Range("B2"), Order1:=xlAscending, Key2:=.Range("D2"), Order2:=xlAscending, _ Header:=xlYes End With


and adjusted the two sort columns.

The user form that I'm using my code in is frmDate that's linked to the button "Quick Search For Leave By Date" on both worksheets "Dashbooard" and "Leave Request". I'm having troubles with the button "Quick Search For Leave By Date" on worksheet "Dashbooard" getting it to search for date that's put in Textbox1 on the "frmDate" userform. Does this make since???

Best regards,,

Charlie

mdmackillop
02-23-2008, 06:35 AM
Can you repost the latest version of your workbook?

coliervile
02-23-2008, 06:41 AM
Here you go Sir.

Best regards,

Charlie

mdmackillop
02-23-2008, 06:52 AM
try this

coliervile
02-23-2008, 07:14 AM
Thank you so very much. What did you change in the coding? I noticed you changed the coding in the frmName too...thanks.

Best regards,

Charlie

coliervile
02-23-2008, 07:25 AM
Did you make both codes the same in this way (colored in red);

.Range("A:E").Sort Key1:=.Range("D2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes

and made this line of the coding run the same line;

.Range("A:E").Sort Key1:=.Range("D2"), Order1:=xlAscending, _

Best regards,

Charlie

mdmackillop
02-23-2008, 07:36 AM
I also enclose both fins within one encompasing With statement.

re Date find, You can tidy up the result by removing the repeating search date

Private Sub TextBox1_AfterUpdate()
Dim mpLastRow As Long
Dim mpRows As Variant
Dim mpNames As Range
Dim mpDatesStart As Range
Dim mpDatesEnd As Range
Dim mpTestDate As Date
Dim mpMessage As String
Dim mpMes As String
Dim LastRowPrintout As Long
Dim i As Long
With Worksheets("Leave Request")
.Activate
.Range("A:E").Sort Key1:=.Range("B2"), Order1:=xlAscending, _
Key2:=.Range("D2"), Order2:=xlAscending, _
Header:=xlYes
mpTestDate = CDate(Me.TextBox1.Text)
mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set mpDatesStart = .Range("D1").Resize(mpLastRow)
Set mpDatesEnd = .Range("E1").Resize(mpLastRow)
Set mpNames = .Range("A1").Resize(mpLastRow)
mpRows = .Evaluate("IF((" & mpDatesStart.Address & _
"<=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)*" & _
"(" & mpDatesEnd.Address & ">=--""" & _
Format(mpTestDate, "yyyy-mm-dd") & """)," & _
"ROW(" & mpNames.Address & "))")
mpMes = mpMessage & "Requested" & " " & mpTestDate & " " & _
"Off " & String(75, "_") & vbCr & vbCr
For i = LBound(mpRows) To UBound(mpRows)
If mpRows(i, 1) <> False Then
mpMessage = mpMessage & mpNames.Cells(i, 1).Value & _
" (Leave type: " & mpNames.Cells(i, 3).Value & _
", Requested on: " & mpNames.Cells(i, 2).Text & ")" & vbNewLine & vbNewLine
LastRowPrintout = Worksheets("Printout").Range("A" & Rows.Count).End(xlUp).Row
.Rows(i).Copy Worksheets("Printout").Range("A" & LastRowPrintout + 1)
End If
Next i
If mpMessage <> "" Then
MsgBox mpMes & mpMessage, vbOKOnly + vbInformation
Else
MsgBox "No Leave Request For This Date", vbOKOnly + vbInformation
End If
.Range("A:E").Sort Key1:=.Range("D2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes
End With
End Sub