samiam2010
07-20-2010, 11:43 AM
Hello, I am very much a "greenie" when it comes to using VBA. I am hoping someone can assist me with the following code. Each day, there are reports which I work with which are generated daily. What I am wanting to do is to enter a comment depending upon a date variable that changes.
I've attached a sample Excel file (please note there are two sheets and the second sheet is essential to the formula within the macro). The first two rows are how the data appears when it's generated, minus the highlighted cells. Rows 4-5 and 7-8 are how I want the macro to work, essentially. The "comment" added is what is dependent upon the "Cutoff Date" column. If the cutoff date is more than 2 days from the day I run the report, then I want the comment to be "cutoff later." If the date in the "Cutoff Date" column is +two days or prior, then I want the comment, "needs prompt" to be added"
When I try to run the following, I get a run-time error '13' type mismatch. Some of the lines may be redundant or unnecessary as I was taking an existing macro and trying to modify it for a different report. Any help would be greatly appreciated!
Sub FilteringCuttoffDates()
Dim ballotID As Integer
Dim iRow As Integer
Dim iballotIDColumn As Integer
Dim iISMFORENSICColumn As Integer
Dim iCutoffDateColumn As Integer
Dim bNextRow As Boolean
iISMFORENSICColumn = Cells.Find(What:="ISM Forensic", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
iCutoffDateColumn = Cells.Find(What:="Cutoff Date", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
iballotIDColumn = Cells.Find(What:="Ballot ID", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
' Add the VE analyst names
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "VETeam"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[5],VETeam!C[1]:C[2],2,FALSE)"
Selection.AutoFill Destination:=Range("A2:A" & Range("F" & Rows.Count).End(xlUp).Row)
Range("A2:A" & Range("F" & Rows.Count).End(xlUp).Row).Select
' Autosize the column after filling it all in.
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Comments"
' Loop through all the rows and make appropriate checks.
' Keep looping until the Ballot ID column comes back blank.
iRow = 1
Do While Cells(iRow, iballotIDColumn).Value <> ""
bNextRow = False
iRow = iRow + 1
' Check for ISM Forensic of Missing Recommendations and Cutoff Date Later
If Cells(iRow, iISMFORENSICColumn).Value = "Recommendations are missing" And (CDate(Cells(iRow, iCutoffDateColumn).Value) > CDate(DateAdd("d", 2, Now))) Then
Cells(iRow, 1).Value = "cutoff later"
bNextRow = True
End If
' Check for ISM Forensic of Missing Recommendations and Cutoff Date Passed
If Not bNextRow And Cells(iRow, iISMFORENSICColumn).Value = "Recommendations are missing" And (CDate(Cells(iRow, iCutoffDateColumn).Value) < CDate(DateAdd("d", 2, Now))) Then
Cells(iRow, 1).Value = "needs prompt"
bNextRow = True
End If
Loop
' Autosize the column after filling it all in.
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
End Sub
I've attached a sample Excel file (please note there are two sheets and the second sheet is essential to the formula within the macro). The first two rows are how the data appears when it's generated, minus the highlighted cells. Rows 4-5 and 7-8 are how I want the macro to work, essentially. The "comment" added is what is dependent upon the "Cutoff Date" column. If the cutoff date is more than 2 days from the day I run the report, then I want the comment to be "cutoff later." If the date in the "Cutoff Date" column is +two days or prior, then I want the comment, "needs prompt" to be added"
When I try to run the following, I get a run-time error '13' type mismatch. Some of the lines may be redundant or unnecessary as I was taking an existing macro and trying to modify it for a different report. Any help would be greatly appreciated!
Sub FilteringCuttoffDates()
Dim ballotID As Integer
Dim iRow As Integer
Dim iballotIDColumn As Integer
Dim iISMFORENSICColumn As Integer
Dim iCutoffDateColumn As Integer
Dim bNextRow As Boolean
iISMFORENSICColumn = Cells.Find(What:="ISM Forensic", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
iCutoffDateColumn = Cells.Find(What:="Cutoff Date", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
iballotIDColumn = Cells.Find(What:="Ballot ID", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
' Add the VE analyst names
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "VETeam"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[5],VETeam!C[1]:C[2],2,FALSE)"
Selection.AutoFill Destination:=Range("A2:A" & Range("F" & Rows.Count).End(xlUp).Row)
Range("A2:A" & Range("F" & Rows.Count).End(xlUp).Row).Select
' Autosize the column after filling it all in.
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Comments"
' Loop through all the rows and make appropriate checks.
' Keep looping until the Ballot ID column comes back blank.
iRow = 1
Do While Cells(iRow, iballotIDColumn).Value <> ""
bNextRow = False
iRow = iRow + 1
' Check for ISM Forensic of Missing Recommendations and Cutoff Date Later
If Cells(iRow, iISMFORENSICColumn).Value = "Recommendations are missing" And (CDate(Cells(iRow, iCutoffDateColumn).Value) > CDate(DateAdd("d", 2, Now))) Then
Cells(iRow, 1).Value = "cutoff later"
bNextRow = True
End If
' Check for ISM Forensic of Missing Recommendations and Cutoff Date Passed
If Not bNextRow And Cells(iRow, iISMFORENSICColumn).Value = "Recommendations are missing" And (CDate(Cells(iRow, iCutoffDateColumn).Value) < CDate(DateAdd("d", 2, Now))) Then
Cells(iRow, 1).Value = "needs prompt"
bNextRow = True
End If
Loop
' Autosize the column after filling it all in.
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
End Sub