Transitioning from Passive Error Flagging to Automatic Correction?

[Damian Carrillo]

Last month I posted regarding an issue I had encountered with <a
href="http://groups.google.com/group/
microsoft.public.excel.programming/browse_thread/thread/
299627eb5d36ff66/12ae5022656f1dfb?
hl=en&lnk=raot#12ae5022656f1dfb">date behavior changing</a> in my VBA
code. I was able to resolve that issue but now I want to go to the
next level.

I understand from various guides and books that Functions cannot alter
any cell other than the one in which they are called. So the function
I created allows me to Flag a row as containing invalid information.
But I would like to make a subroutine with the same functionality, but
with additional code to take action to resolve certain flagged errors,
rather than making the user fix them manually.

Sometimes its the simplest concepts that really seem to throw me.
With the following code, assume we're working with a variable sized
data set, which is currently occupying the area A2:B100 where column A
is InvDate and column B is DepDate. I want to do the following:

'Insertion Point for new Automatic Date Value Correction Sequence
'Primary Objectives:
'#1. VERIFY THE PRESENCE OF VALUE
' If IsBlank(DepDate) = True Then
' Select Case IsBlank(InvDate)
' Case True
' InvDate = DateValue(Today()).Value
' DepDate = DateValue(Today()).Value
' Case False
' DepDate = DateValue(Today()).Value
' End Select
' End If
'
'#2 VERIFY THE PRESENCE OF DATE FORMAT
' If IsDate(DepDate) = False Then
' Select Case IsDate(InvDate)
' Case True
' DepDate = InvDate
' Case False
' InvDate = DateValue(Today()).Value
' DepDate = DateValue(Today()).Value
' End Select
' End If
'
'#3 CHECK FOR FUTURE DATED TRANSACTIONS
' If DateValue(DepDate) > Now
' Select Case DateValue(InvDate)
' Case <= Now
' DepDate = InvDate
' Case > Now
' DepDate = DateValue(Today()).Value
' End Select
' End If

As you can see I basically cut the code right out of my functioning
macro. The idifficulty I'm encountering is that my macro is always
referencing the cell from which it is being called, so I have a
relative starting point. In a subroutine the reference is not fixed,
so I'm having a hard time declaring the parameters to constrain my
subroutine. See the awful not-working code below:

' Dim RowCounter As Integer, CellValue As String
' Dim FirstRow As Integer, LastRow As Integer
' Dim InvDateValue As Date, DepDateValue As Date
'
' Let FirstRow = 2
' Let LastRow = Cells(2, 1).End(xlDown).Row
'
' For RowCounter = FirstRow To LastRow
' With Workbooks("Travel.xls").Worksheets(1).Range("H" &
RowCounter)
' If IsDate(InvDateValue) = False Then
' Let InvDateValue =
CellValue.SpecialCells(xlCellTypeVisible).FormulaR1C1 =
"=DATEVALUE(TODAY())"
' If DateValue(DepDate) > Now Then
' Let Result = "Future Date"
' If IsMissing(InvDate) = False And DepDate = "" Then
' Let Result = "Use InvDate"
' End If
'
'
' End With
' Next RowCounter

Any recommendations about how to best accomplish these three
objectives listed above? I'm so used to making functions that I can't
seem to think outside the self-referencing box on this one. Any help/
advice is greatly appreciated.

Damian

 

[DomThePom]

This should do the trick:

Sub checkData()
Dim rngData As Range
Dim rngRow As Range
Dim rngInvDate As Range
Dim rngDepDate As Range
Const DATA_SHEET As String = "Data"

'assumptions:
'1. data is on sheet called Data
'2. data range has a header row
'3. Data starts in "A1" of data sheet and has no blank rows

'define your data range
Set rngData = Sheets("DATA_SHEET").Cells(1, 1).CurrentRegion
'exclude header row
Set rngData = rngData.Offset(1, 0).Resize(rngData.Rows.Count - 1)

'run through each row of data
For Each rngRow In rngData.Rows
'define the 2 cells that you want to validate / fix
Set rngInvDate = rngRow.Cells(1, 1)
Set rngDepDate = rngRow.Cells(1, 2)


'now cells have been deefined we can use your code
'a few points here
'1. today is a worksheet function - vba equivalent is date()
'2. Date() produces a date type so you do not need datevalue
'3. isempty is a worksheet funvtion - use vba isempty
'4. To avoid ambiguity, explicitly specify the value property of the
ranges
' we are looking at
'5. Good practise to prefix variable names with data type so you always
' know what you are working on

'#1. VERIFY THE PRESENCE OF VALUE
If IsEmpty(rngDepDate.Value) = True Then
Select Case IsEmpty(rngInvDate.Value)
Case True
rngInvDate.Value = Date
rngDepDate.Value = Date
Case False
rngDepDate.Value = Date
End Select
End If

'#2 VERIFY THE PRESENCE OF DATE FORMAT
If IsDate(rngDepDate.Value) = False Then
Select Case IsDate(rngInvDate.Value)
Case True
rngDepDate.Value = rngInvDate.Value
Case False
rngInvDate.Value = Date
rngDepDate.Value = Date
End Select
End If

'#3 CHECK FOR FUTURE DATED TRANSACTIONS
If DateValue(rngDepDate.Value) > Now Then
Select Case DateValue(rngInvDate.Value)
Case Is <= Now
rngDepDate.Value = rngInvDate.Value
Case Is > Now
rngDepDate.Value = Date
End Select
End If
Next rngRow

ProcExit:
'clean up objects
Set rngData = Nothing
Set rngRow = Nothing
Set rngInvDate = Nothing
Set rngDepDate = Nothing
ProcError:

MsgBox Err.Description
Resume ProcExit


End Sub

 

[Damian Carrillo]

DomThePom, Thanks so much. I gave it a test run and got it to work
based on your assumptions. I'm now modifying it to work with my
dataset. Will let you know how it turns out!

-Damian