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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.