CODEWITHSUNDEEP
arraysexcelif-statementvba
diego
diego

Reputation: 169

How to nest an if condition inside another one

I have a macro that works fine pasting an array in a column, now I want to paste a new array in the second column, the problem is that to paste the value it has to fulfill some conditions, so I have to nest an if condition inside another one, it gives me no error but it doesn't work... this is what I have:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A, L:L")) Is Nothing Then
        On Error GoTo Fìn
        Application.EnableEvents = False
        Dim i As Long, n As Long
        Dim arrmatrix As Variant
        ReDim arrmatrix(1 To 1, 1 To 1)
        For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
            If Cells(i, 12).Value = "Pi emitida" Then
                n = n + 1
                ReDim Preserve arrmatrix(1 To 1, 1 To n)
                arrmatrix(1, n) = Cells(i, 1).Value
            End If
        Next i
        With Worksheets("Inicio")
            .Range("G4:G" & Rows.Count).ClearContents
            .Range("G4").Resize(UBound(arrmatrix, 2), 1) =   Application.Transpose(arrmatrix)
        End With
    End If
    If Not Intersect(Target, Range("A:A, Q:Q,L:L")) Is Nothing Then
        On Error GoTo Fìn
        Application.EnableEvents = False
        Dim j As Long, m As Long
        Dim arrmatrix1 As Variant
        ReDim arrmatrix1(1 To 1, 1 To 1)
        For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row
            'THIS IS THE PROBLEM.....!!!!!!!!!!!!!!!
            If Cells(j, 12).Value = "Pi emitida" Or Cells(j, 12).Value = "PI    firmada" Or Cells(j, 12).Value = "Carta credito L/c" Or Cells(j, 12).Value =  "Con booking" Then
                If DateDiff(d, Cells(j, 17).Value, Today) > 0 Then
                    m = m + 1
                    ReDim Preserve arrmatrix1(1 To 1, 1 To m)
                    arrmatrix1(1, m) = Cells(j, 1).Value
                End If

        Next j
        With Worksheets("Inicio")
            .Range("H4:H" & Rows.Count).ClearContents
            .Range("H4").Resize(UBound(arrmatrix1, 2), 1) =    Application.Transpose(arrmatrix1)
        End With
    End If

Fìn:
    Application.EnableEvents = True
End Sub

Upvotes: 0

Views: 79

Answers (1)

Divin3
Divin3

Reputation: 548

try this:

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A, L:L")) Is Nothing Then
    On Error GoTo Fìn
    Application.EnableEvents = False
    Dim i As Long, n As Long
    Dim arrmatrix As Variant
    ReDim arrmatrix(1 To 1, 1 To 1)
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 12).Value = "Pi emitida" Then
            n = n + 1
            ReDim Preserve arrmatrix(1 To 1, 1 To n)
            arrmatrix(1, n) = Cells(i, 1).Value
        End If
    Next i
    With Worksheets("Inicio")
        .Range("G4:G" & Rows.Count).ClearContents
        .Range("G4").Resize(UBound(arrmatrix, 2), 1) =   Application.Transpose(arrmatrix)
    End With
    End If
    If Not Intersect(Target, Range("A:A, Q:Q,L:L")) Is Nothing Then
    On Error GoTo Fìn
    Application.EnableEvents = False
    Dim j As Long, m As Long
    Dim arrmatrix1 As Variant
    ReDim arrmatrix1(1 To 1, 1 To 1)
    For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row

  'THIS IS THE PROBLEM.....!!!!!!!!!!!!!!!
    If Cells(j, 12).Value = "Pi emitida" Or Cells(j, 12).Value = "PI    firmada" Or Cells(j, 12).Value = "Carta credito L/c" Or Cells(j, 12).Value =  "Con booking" Then
        If DateDiff(d, Cells(j, 17).Value, Today) > 0 Then

            m = m + 1
            ReDim Preserve arrmatrix1(1 To 1, 1 To m)
            arrmatrix1(1, m) = Cells(j, 1).Value
        End If

    End If    
    Next j
    With Worksheets("Inicio")
        .Range("H4:H" & Rows.Count).ClearContents
        .Range("H4").Resize(UBound(arrmatrix1, 2), 1) =    Application.Transpose(arrmatrix1)
    End With


 Fìn:
Application.EnableEvents = True
End Sub

Upvotes: 1

Related Questions