Solved: Find Greater Than

[Mcygee]

Hello everybody!

I've been working hard on a code to automatically sort some data. I'm almost finished! However, I ran into a hopefully simple problem someone can resolve. Here is some code that I modified. The original code is thanks to XLD from another post. I just made it a loop and copy to new rows each time.

----------------------------------------------------


Sub seperate()

'----Stop Excel from Refreshing the Screen Until Macro is Done----
Application.ScreenUpdating = False

RowAdd = 2
Do

Sheets("Sheet1").Select
Columns("G:G").Select
NumPro = "Teacher3"
Set cell = Cells.Find(What:=NumPro, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not cell Is Nothing Then

ChangingA = "A" & RowAdd
ChangingJ = "J" & RowAdd

'adjust these cells accordingly
Worksheets("Sheet2").Range(ChangingA, ChangingJ).Value = Range(Cells(cell.Row, "A"), Cells(cell.Row, "J")).Value

cell.EntireRow.Delete

RowAdd = RowAdd + 1
End If

Loop Until (cell Is Nothing)

End Sub

---------------------------------------------------

This is doing almost exactly what I want it to do, except for one small thing. In order to complete most of the code I just had it search for "Teacher3" for test purposes. But I need to change it.

I need it to find numbers greater than a specific number instead of text. Specifically, any time greater than 2:30.

So I'm wondering if there is a way to make this part of the code....

NumPro = "Teacher3"
Set cell = Cells.Find(What:=NumPro, _

Request any time greater than 2:30 P.M. or 14:30, instead of searching for the string "Teacher3". I'm sure if I can at least make it just search for a number greater than X I can figure out the time part on my own. Either way I could use the help.

ANY HELP IS MUCH APPRECIATED!

[mdmackillop]

You can't use > in a search.
There are a couple of ways to approach this. Loop and look at each value or possibly filter and process filtered values. Is your data ordered? How many rows are you searching?
Can you post a sample workbook?

[Mcygee]

Thank You for the quick response! I'm disapointed to hear it may not be an easy fix. Seems like something you should be able to do.

I attached the workbook I'm doing all this from. It's not everything I have but it will work for figuring this problem out.

The data that's in "SHEET1" is example data that should replicate exactly what needs to be sorted into "SHEET2."

There are several macros in the worksheet but the ONLY one that we are dealing with here is the one called "SEPERATE." If you run it, you'll see that the row that has "Teacher3" for the teacher will be removed and placed into "SHEET2". So what I need it to do instead is move the row if the "START TIME" column has a time that is later than 14:30 aka 2:30 P.M.

Hope this helps. Let me know what else I can do.

[mdmackillop]

Sub Separate2()
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim Rw As Long
Dim StartTime As Date

StartTime = TimeValue("14:30:00")
Set Sh1 = Sheets(1)
Set Sh2 = Sheets(2)

Rw = Sh1.Cells(Rows.Count, 5).End(xlUp).Row
For i = Rw To 2 Step -1
If Sh1.Cells(i, 5) > StartTime Then
Sh1.Cells(i, 1).Resize(, 10).Cut Sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next
End Sub

[mdmackillop]

BTW, you should try to avoid selecting ranges. It is rarely neccessary and slows down execution.

Sub seperate()

'----Stop Excel from Refreshing the Screen Until Macro is Done----
Application.ScreenUpdating = False
NumPro = "Teacher3"
RowAdd = 2
Do
Set cell = Sheets("Sheet1").Columns("G:G").Find(What:=NumPro, LookIn:=xlFormulas)
If Not cell Is Nothing Then
ChangingA = "A" & RowAdd
ChangingJ = "J" & RowAdd
'adjust these cells accordingly
Worksheets("Sheet2").Range(ChangingA, ChangingJ).Value = Range(Cells(cell.Row, "A"), Cells(cell.Row, "J")).Value
cell.EntireRow.Delete
RowAdd = RowAdd + 1
End If
Loop Until cell Is Nothing
End Sub

[Mcygee]

OMG Your amazing! That worked great!!!! There's only one more thing I need it to do. Is it possible to delete the entire row that has been cut from in Sheet1? Once they are removed I need the row to be deleted so that the other rows are all together. Is this possible? In the old code I had it was.....

cell.EntireRow.Delete

[mdmackillop]

Sh1.Cells(i, 1).Resize(, 10).Cut Sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
Sh1.Cells(i, 1).EntireRow.Delete

[Mcygee]

Awsome! I should have figured that out myself and started to look at it as soon as I posted that reply, but then my wife yelled at me to get off the computer lol. What can ya do?

Thanks so much for all your hard work! Many people will benefit from this.