Help on IF THEN code

[Chip87]

Hi,

I am very knew to VBA, just starting actually. I am looking for a way to automate a report. What I am looking for is:

If Months(column A) is 12 and Days(column B) < 365 then Days +30,
If Months is 6 and Days < 180 then Days +30,
If Months is 3 and Days < 90 then Days +30,

so like for row 3, Months is 12 and Days is 344, I would like to get 344+30 = 374

I do not want to use a formula, this report is extensive and I want to create one macro to deal with it in one press of a button

I would really appreciate any help on this.

Thanks!

 

[steve the fish]

Where are these new numbers going? Overwriting column B? Column C?

 

[mikerickson]

Try

With Range("A:A")
    With Range(.Cells(1,2, .Cells(1, Rows.Count).End(xlup)).Offset(0,2)
        .FormulaR1C1 = "=RC2 + IF(RC1=12, IF(RC2<365),1,0),0)"
        .Value = .Value
    End With
End With

 

[Chip87]

Where are these new numbers going? Overwriting column B? Column C?

Does not matter, want to see the logic behind it and then I can adjust. Thanks

 

[steve the fish]

This would do an overwrite.

With Sheets("Sheet2")
    lr = .Range("A" & .Rows.Count).End(xlUp).Row
    If lr > 1 Then
        arr = .Range("A2:B" & lr)
        For i = LBound(arr) To UBound(arr)
            Select Case arr(i, 1)
                Case 3: If arr(i, 2) < 90 Then arr(i, 2) = arr(i, 2) + 30
                Case 6: If arr(i, 2) < 180 Then arr(i, 2) = arr(i, 2) + 30
                Case 12: If arr(i, 2) < 365 Then arr(i, 2) = arr(i, 2) + 30
            End Select
            
        Next
        .Range("A2:B" & lr) = arr
    End If
End With

 

[Chip87]

Thanks guys!

 

[lezawang]

Hi this is another style if you are interested

Sub change_day()
    Dim x As Double
    For x = 2 To Rows.Count
        If Cells(x, 1) = 12 And Cells(x, 2) < 365 Then
            Cells(x, 2) = Cells(x, 2) + 30
        ElseIf Cells(x, 1) = 6 And Cells(x, 2) < 180 Then
            Cells(x, 2) = Cells(x, 2) + 30
        ElseIf Cells(x, 1) = 3 And Cells(x, 2) < 90 Then
            Cells(x, 2) = Cells(x, 2) + 30
        End If
    Next x
End Sub