macro hangs if no data is found

[MJKelly]

Hi,

The code below hangs for ages if their are no occurancies in the data
which match the task variable.
The macro basically loops through a range and looks for a match of the
task variable. if a match is found the section of the row is copied
to another sheet and some formatting takes place at the end.

When i run this code and numerous matches are found the code runs
quick and all seems fine, but if there are no matches the code just
hangs. I've only included the "Else a.Interior.ColorIndex = 1" to see
that the code is checking the range.

The full code is below, but I think the problem is in this section?

ThisWorkbook.Sheets("AWD Grid").Select
For Each a In ThisWorkbook.Sheets("AWD Grid").Range("B2:B1000")
If Not a.Value = "" Then
For Each b In Range(Cells(a.Row, useTimeWindow), Cells(a.Row,
useTimeWindow + 23))
If b.Value = Task Then
Range(Cells(a.Row, useTimeWindow), Cells(a.Row,
useTimeWindow + 23)).Copy
Sheets("Workaid").Range("C4").Offset(myRowOffset, 0)
Sheets("Workaid").Range("C4").Offset(myRowOffset,
-2).Value = Cells(b.Row, 1).Value
Sheets("Workaid").Range("C4").Offset(myRowOffset,
-1).Value = Cells(b.Row, 2).Value
myRowOffset = myRowOffset + 1
Exit For
End If
Next b
Else
a.Interior.ColorIndex = 1
End If

Next a

Hope you can help.
Regards,
Matt




Private Sub CommandButton2_Click()
'produce the workaid

ThisWorkbook.Save


Dim TimeWindow As String
Dim Task As String

TimeWindow = ComboBox2.Value
Task = ComboBox3.Value

Dim useTimeWindow As Integer

If TimeWindow = "06:00 - 10:00" Then
useTimeWindow = 7
ThisWorkbook.Sheets("Workaid").Select
Range("C3").Value = "06:00"
Range("D3").Value = "06:10"
Range("C33").Select
Selection.AutoFill Destination:=Range("C3:Z3"),
Type:=xlFillDefault
ElseIf TimeWindow = "10:00 - 14:00" Then
useTimeWindow = 31
ThisWorkbook.Sheets("Workaid").Select
Range("C3").Value = "10:00"
Range("D3").Value = "10:10"
Range("C33").Select
Selection.AutoFill Destination:=Range("C3:Z3"),
Type:=xlFillDefault
ElseIf TimeWindow = "14:00 - 18:00" Then
useTimeWindow = 55
ThisWorkbook.Sheets("Workaid").Select
Range("C3").Value = "14:00"
Range("D3").Value = "14:10"
Range("C33").Select
Selection.AutoFill Destination:=Range("C3:Z3"),
Type:=xlFillDefault
ElseIf TimeWindow = "18:00 - 22:00" Then
useTimeWindow = 79
ThisWorkbook.Sheets("Workaid").Select
Range("C3").Value = "18:00"
Range("D3").Value = "18:10"
Range("C33").Select
Selection.AutoFill Destination:=Range("C3:Z3"),
Type:=xlFillDefault
ElseIf TimeWindow = "22:00 - 02:00" Then
useTimeWindow = 103
ThisWorkbook.Sheets("Workaid").Select
Range("C3").Value = "22:00"
Range("D3").Value = "22:10"
Range("C33").Select
Selection.AutoFill Destination:=Range("C3:Z3"),
Type:=xlFillDefault
ElseIf TimeWindow = "02:00 - 06:00" Then
useTimeWindow = 127
ThisWorkbook.Sheets("Workaid").Select
Range("C3").Value = "02:00"
Range("D3").Value = "02:10"
Range("C33").Select
Selection.AutoFill Destination:=Range("C3:Z3"),
Type:=xlFillDefault
End If



Dim a As Range
Dim b As Range
Dim c As Range

Dim myRowOffset As Integer

ThisWorkbook.Sheets("Workaid").Range("A4:Z500").Clear

ThisWorkbook.Sheets("AWD Grid").Select
For Each a In ThisWorkbook.Sheets("AWD Grid").Range("B2:B1000")
If Not a.Value = "" Then
For Each b In Range(Cells(a.Row, useTimeWindow), Cells(a.Row,
useTimeWindow + 23))
If b.Value = Task Then
Range(Cells(a.Row, useTimeWindow), Cells(a.Row,
useTimeWindow + 23)).Copy
Sheets("Workaid").Range("C4").Offset(myRowOffset, 0)
Sheets("Workaid").Range("C4").Offset(myRowOffset,
-2).Value = Cells(b.Row, 1).Value
Sheets("Workaid").Range("C4").Offset(myRowOffset,
-1).Value = Cells(b.Row, 2).Value
myRowOffset = myRowOffset + 1
Exit For
End If
Next b
Else
a.Interior.ColorIndex = 1
End If

Next a

ThisWorkbook.Sheets("Workaid").Select
Dim EndOfRange As String

Range("C4").End(xlToRight).End(xlDown).Select
Range("C4", ActiveCell).Select

For Each c In Selection
If c.Value = "PM" Then
c.Interior.ColorIndex = Range("C1").Interior.ColorIndex
ElseIf c.Value = "XD" Then
c.Interior.ColorIndex = Range("G1").Interior.ColorIndex
ElseIf c.Value = "MHE" Then
c.Interior.ColorIndex = Range("L1").Interior.ColorIndex
ElseIf c.Value = "MR" Then
c.Interior.ColorIndex = Range("P1").Interior.ColorIndex
ElseIf c.Value = "" Then
c.Interior.ColorIndex = 2
Else: c.Interior.ColorIndex = Range("T1").Interior.ColorIndex
End If


Next c

Selection.ClearContents
Unload frmWorkaid


End Sub

 

[ShaneDevenshire]

Hi,

Put a couple of breakpoints in your code to determine where the hang up is.

 

[ShaneDevenshire]

Hi again,

You have 1000 rows and your checking each one 23 time, so the code will loop
23,000 times if it doesn't find the entry? is that what you are trying to
do?

 

[Sheeloo]

If b.Value = Task is NOT TRUE then
For Each b In Range(Cells(a.Row, useTimeWindow), Cells(a.Row,
useTimeWindow + 23))
is executed 23 times for each a for a total of 23,000 times...
which should not take too much of a time...

add a count variable and see how many times it is executed. Also put out a
msgbox before entering the loop and one after entering the loop to see
whether the problem is in the loop (ideal way is to set break points...)

Let us know.
Send me the file if you can...

 

[MJKelly]

Thanks for the responses guys. I'll try your suggestions today and
let you know what happens. In the mean time, you mention that I am
checking each row 23 times (so 23,000 row checks), but i thought I was
just using the + 23 to declare the size of the range within the row to
check ie column 7 to column 30. Is this not the case? Also, i am
using exit for, so if "Task" is found it does not continue to check
the remainder of that row and just proceeds to the next row?

Could I use a find command to find "task" within the portion of the
row and if found then copy that portion? is there a way of checking
that the find is true or false.

many thanks,
Matt
PS - Sheeloo, If I am unable to get round this, I'd like to take you
up on your offer to send you the file?

 

[Sheeloo]

If Task is not found then you check 23,000 cells..
You are welcome to share the file...
You can use FIND like in the code segment below;
'----------------------
Dim c As Range, rowno As Long, colno as long
Set c = Cells.Find("What you want to find")
If Not c Is Nothing Then
'Column Number of the cell
colno = c.Column
'Row Number of the cell
rowno = s.Row
Else
'Exit of change this to do what you want
Exit Sub
End If

'----------------------

 

[MJKelly]

Thanks everyone for your help - I have found the problem. I was
convinced the issue was in the loop and checking of all those rows,
but taking your advice and adding some msgbox prompts at certain
points of the code proved that the loop was fine. It was the code
below which caused the problem. if no data was copied into the
workaid workhseet then the code had most of the empty sheet checked
for the values below.

I've fixed this by adding an if to check if "C4" holds a value and if
not then exit the sub at that point.

Again, thanks for your help.
kindest regards,
Matt



Range("C4").End(xlToRight).End(xlDown).Select
Range("C4", ActiveCell).Select

For Each c In Selection
If c.Value = "PM" Then
c.Interior.ColorIndex = Range("C1").Interior.ColorIndex
ElseIf c.Value = "XD" Then
c.Interior.ColorIndex = Range("G1").Interior.ColorIndex
ElseIf c.Value = "MHE" Then
c.Interior.ColorIndex = Range("L1").Interior.ColorIndex
ElseIf c.Value = "MR" Then
c.Interior.ColorIndex = Range("P1").Interior.ColorIndex
ElseIf c.Value = "" Then
c.Interior.ColorIndex = 2
Else: c.Interior.ColorIndex = Range("T1").Interior.ColorIndex
End If

Next c