Using Intersect for validation checking iterating down columns using code.
But this is excruciatingly slow. Is there a faster way? NOTE: I use range
names so if client wants us to add, remove or move columns, I don't have to
recode the entire program as I did when using activecell.Offset() methods.
Here's a snippet:

CheckThisSite ("resSite")

Sub CheckThisSite(WhichRange) 'Site
Dim curval As String
Dim rowval As Range, rw As Range, vMsg As String
Dim c As Range
Application.ScreenUpdating = False
Worksheets(sheetType).Activate
For Each c In Range(WhichRange).Cells
c.Select
Set rw = ActiveCell.EntireRow

If Intersect(Range("resMeasure"), rw) < "" Then
Set rowval = Intersect(Range("resRecNum"), rw)
rngMeas = "resMeasure"
End If

'pick up only rows with data (i.e. measures)
If (Not IsNumeric(c.Value)) And (Intersect(Range(rngMeas), rw)) < "" Then
With Selection.Interior
.ColorIndex = 8 'blue
.Pattern = xlSolid
End With

curval = ActiveCell

Sheets("DataEntry-Errors").Activate
ActiveCell = rowval
ActiveCell.Offset(0, 1) = curval
ActiveCell.Offset(1, 0).Select
Sheets(sheetType).Activate
end if
Next

Perico wrote:

Using Intersect for validation checking iterating down columns using code.
But this is excruciatingly slow. Is there a faster way? NOTE: I use range
names so if client wants us to add, remove or move columns, I don't have to
recode the entire program as I did when using activecell.Offset() methods.
Here's a snippet:

CheckThisSite ("resSite")

Sub CheckThisSite(WhichRange) 'Site
Dim curval As String
Dim rowval As Range, rw As Range, vMsg As String
Dim c As Range
Application.ScreenUpdating = False
Worksheets(sheetType).Activate
For Each c In Range(WhichRange).Cells
c.Select
Set rw = ActiveCell.EntireRow

If Intersect(Range("resMeasure"), rw) < "" Then
Set rowval = Intersect(Range("resRecNum"), rw)
rngMeas = "resMeasure"
End If

'pick up only rows with data (i.e. measures)
If (Not IsNumeric(c.Value)) And (Intersect(Range(rngMeas), rw)) < "" Then
With Selection.Interior
.ColorIndex = 8 'blue
.Pattern = xlSolid
End With

curval = ActiveCell

Sheets("DataEntry-Errors").Activate
ActiveCell = rowval
ActiveCell.Offset(0, 1) = curval
ActiveCell.Offset(1, 0).Select
Sheets(sheetType).Activate
end if
Next

Hi Perico,

Using .Select followed by Selection. or ActiveCell. slows things down
considerably.
Use them only when absolutely necessary.

For example, change...

c.Select
Set rw = ActiveCell.EntireRow

to...

Set rw = c.EntireRow


Also, change...

With Selection.Interior

to...

With c.Interior

since I think c is the selection at the time.

Similarly with the rest of your code. I'd better not suggest changes
there, I could get it wrong.

Ken Johnson

Regarding the rest of your code, it shouldn't be necessary to activate
worksheets. Not knowing what the activecell originally was for the
DataEntry-Errors worksheet, I just used A1 in the example below. You could
set up a variable (lngCount) which starts at 0 and increments by 1 each time
through the loop to handle the number of rows to offset from your beginning
cell. By not activating the DataEntry worksheet, this line becomes
unnecessary <Sheets(sheetType).Activate

Also, curval = Activecell seems unneeded also as the activecell is still c,
correct?

instead of
curval = ActiveCell

Sheets("DataEntry-Errors").Activate
ActiveCell = rowval
ActiveCell.Offset(0, 1) = curval
ActiveCell.Offset(1, 0).Select
Sheets(sheetType).Activate
end if
Next

perhaps something more like:
With Sheets("DataEntry-Errors")
.Range("A1").Offset(lngCount, 0).Value = rowval
.Range("A1").Offset(lngCount, 1).Value = c.Value
End With
lngCount = lngCount + 1
End If
Next

Just wanted to give an example of referencing cells on another worksheet w/o
activating it. You may need to make changes depending on the specifics of
what you're doing - I am making some assumptions. Be sure to backup before
trying anything new.



"Perico" wrote:

Using Intersect for validation checking iterating down columns using code.
But this is excruciatingly slow. Is there a faster way? NOTE: I use range
names so if client wants us to add, remove or move columns, I don't have to
recode the entire program as I did when using activecell.Offset() methods.
Here's a snippet:

CheckThisSite ("resSite")

Sub CheckThisSite(WhichRange) 'Site
Dim curval As String
Dim rowval As Range, rw As Range, vMsg As String
Dim c As Range
Application.ScreenUpdating = False
Worksheets(sheetType).Activate
For Each c In Range(WhichRange).Cells
c.Select
Set rw = ActiveCell.EntireRow

If Intersect(Range("resMeasure"), rw) < "" Then
Set rowval = Intersect(Range("resRecNum"), rw)
rngMeas = "resMeasure"
End If

'pick up only rows with data (i.e. measures)
If (Not IsNumeric(c.Value)) And (Intersect(Range(rngMeas), rw)) < "" Then
With Selection.Interior
.ColorIndex = 8 'blue
.Pattern = xlSolid
End With

curval = ActiveCell

Sheets("DataEntry-Errors").Activate
ActiveCell = rowval
ActiveCell.Offset(0, 1) = curval
ActiveCell.Offset(1, 0).Select
Sheets(sheetType).Activate
end if
Next

Thanks for the responses. I have replace the code with this and it's almost
instantaneous: Note: (LastMeasRow is a public var)

Sub CheckThisSite(WhichRange) 'Site
Dim curval As String
Dim rowval As Long, vMsg As String
Dim c As Range
Application.ScreenUpdating = False
Worksheets(sheetType).Activate

For Each c In Range(WhichRange).Cells

If c.Value = "" And c.Row <= LastMeasRow Then

If (Not IsNumeric(c.Value) Or c.Value = "") Then
With c.Interior
.ColorIndex = 8 'blue
.Pattern = xlSolid
End With

'Check Site value:
curval = c.Value
rowval = c.Row
vMsg = "Site in row"

Sheets("DataEntry-Errors").Activate
ActiveCell = rowval
ActiveCell.Offset(0, 1) = curval
ActiveCell.Offset(0, 2) = "The " & sheetType & " Sheet " & vMsg
& " " & c.Row & " is not a numeric value. Please check the Site for this
record."
ActiveCell.Offset(1, 0).Select
Sheets(sheetType).Activate
End If

End If
Next

End Sub

You would probably get a big boost from turning off calculation
during the macro. Make your other changes first so you can
see the improvements along the way. But turning off
screen updating, which you already have, and turning off calculation
can greatly improve speed whether the code is good or bad..
http://www.mvps.org/dmcritchie/excel/slowresp.htm

---
HTH,
David McRitchie, Microsoft MVP - Excel
My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm

"Perico" wrote in message ...
Using Intersect for validation checking iterating down columns using code.
But this is excruciatingly slow. Is there a faster way? NOTE: I use range
names so if client wants us to add, remove or move columns, I don't have to
recode the entire program as I did when using activecell.Offset() methods.
Here's a snippet:

CheckThisSite ("resSite")

Sub CheckThisSite(WhichRange) 'Site
Dim curval As String
Dim rowval As Range, rw As Range, vMsg As String
Dim c As Range
Application.ScreenUpdating = False
Worksheets(sheetType).Activate
For Each c In Range(WhichRange).Cells
c.Select
Set rw = ActiveCell.EntireRow

If Intersect(Range("resMeasure"), rw) < "" Then
Set rowval = Intersect(Range("resRecNum"), rw)
rngMeas = "resMeasure"
End If

'pick up only rows with data (i.e. measures)
If (Not IsNumeric(c.Value)) And (Intersect(Range(rngMeas), rw)) < "" Then
With Selection.Interior
.ColorIndex = 8 'blue
.Pattern = xlSolid
End With

curval = ActiveCell

Sheets("DataEntry-Errors").Activate
ActiveCell = rowval
ActiveCell.Offset(0, 1) = curval
ActiveCell.Offset(1, 0).Select
Sheets(sheetType).Activate
end if
Next