If Then in VB


Posted by Thomas Venn on March 31, 2000 3:58 PM

Hi, My macro currently fills in 2 fields, then moves down one row, but instead of just moving down one row, I was wondering if there is anyway for it to move only to a row which contains a value. In other word, I am in S5. the macro fills in S5 and T5, then moves to S6. Then I would run the macro again, if there is any value in J6, K6, L6, M6, N6, O6, P6, Q6, or R6. I want the macro to go to column S of the next row which has values. So that if row 7 to 10 is empty and row 11 contains a value, it will go to S11.

Thanks in advance,

Thomas


Sub Initial_and_Date_Fill()
'
'fills in initial and date
'

'
ActiveCell.FormulaR1C1 = _
"=IF(AND(NOT(RC2=""""),NOT(R[-1]C="""")),+R[-1]C, IF(AND(NOT(RC3=""""),NOT(R[-2]C="""")),+R[-2]C, IF(AND(NOT(RC3=""""),NOT(R[-3]C="""")),+R[-3]C, IF(AND(NOT(RC3=""""),NOT(R[-5]C="""")),+R[-5]C, IF(AND(NOT(RC3=""""),NOT(R[-6]C="""")),+R[-6]C, IF(AND(NOT(RC3=""""), NOT(R[-4]C="""")),+R[-4]C,""err""))))))"
Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Calculate
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=NOW()"
Selection.NumberFormat = "m/d"
Selection.Copy
Application.CutCopyMode = False
Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Offset(0, -2).Range("A1").Select
End Sub

Posted by Celia on April 02, 2000 5:18 PM

Thomas
One way to do what you want is to use a loop. Try the following macro. You have to select the range of cells in Column S to be processed before running it.
Celia

Sub EnterColumns_S_T()
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In Selection
If Application.CountA(Range(cell.Offset _
(0, -9), cell.Offset(0, -1))) > 0 Then
With cell
.FormulaR1C1 = [your formula]
.Copy
.PasteSpecial Paste:=xlValues
End With
With cell.Offset(0, 1)
.FormulaR1C1 = "=NOW()"
.NumberFormat = "m/d"
.Copy
.PasteSpecial Paste:=xlValues
End With
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub



Posted by Ivan Moala on April 04, 2000 3:44 AM

Thomas
Another way to do this combining Celias and yours
Sub Initial_and_Date_Fill()
'
'fills in initial and date
'
Dim Fml As String
Dim Myrg

Fml = "=IF(AND(NOT(RC2=""""), NOT(R[-1]C="""")),+R[-1]C, IF(AND(NOT(RC3=""""), NOT(R[-2]C="""")),+R[-2]C, IF(AND(NOT(RC3=""""),NOT(R[-3]C="""")), +R[-3]C, IF(AND(NOT(RC3=""""),NOT(R[-5]C="""")),+R[-5]C, IF(AND(NOT(RC3=""""), NOT(R[-6]C="""")),+R[-6]C, IF(AND(NOT(RC3=""""), NOT(R[-4]C="""")), +R[-4]C,""err""))))))"

again:
If Application.CountA(Range(ActiveCell.Offset(0, -9), ActiveCell.Offset(0, -1))) > 0 Then
ActiveCell.FormulaR1C1 = Fml
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Select
ActiveCell = Format(Now(), "m/d")
ActiveCell.Offset(1, -1).Activate
GoTo again
End If
End Sub

Ivan