G
Guest
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
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