Snasui Excel Forum

Code: Select all

Private Sub FindTargetData()
        '----Other----
        For m = 1 To k
            i = Application.Match(.Cells(m + 6, "a"), rTarget, 0)
            o = Application.CountIf(rTarget, .Cells(m + 6, "a"))
            Set rTgSmall = wsTemp.Range("a1").Offset(i, 0).Resize(o, 1)
            For n = 1 To j * 12
                p = 0
                For Each r In rTgSmall
                        If r.Offset(0, 1) = .Cells(m + 6, "b") Then
                            If r.Offset(0, 2) = .Cells(m + 6, "c") Then
                                If r.Offset(0, 4) = .Cells(m + 6, "d") Then
                                    If r.Offset(0, 7) = .Cells(5, n + 5) Then
                                        If r.Offset(0, 8) = .Cells(6, n + 5) Then
                                            p = p + r.Offset(0, 3)
                                        End If
                                    End If
                                End If
                            End If
                        End If
                Next r
                If p = 0 Then a(m, n) = ""
                If p > 0 Then a(m, n) = p
            Next n
        Next m
        .Range("f7").Resize(k, j * 12).Value = a
        '----Other----
End Sub

Code: Select all

For n = 1 To j * 12
    p = 0
    For Each r In rTgSmall
            If r.Offset(0, 1) = .Cells(m + 6, "b") And _
                r.Offset(0, 2) = .Cells(m + 6, "c") And _
                r.Offset(0, 4) = .Cells(m + 6, "d") And _
                r.Offset(0, 7) = .Cells(5, n + 5) And _
                r.Offset(0, 8) = .Cells(6, n + 5) Then
                    p = p + r.Offset(0, 3)
            End If
    Next r
    If p = 0 Then a(m, n) = ""
    If p > 0 Then a(m, n) = p
Next n

Code: Select all

'Other code
For Each r In rTarget
    r.Offset(0, 1) = Year(r)
    r.Offset(0, 2) = Month(r)
    r.Offset(0, 3) = r.Offset(0, -8) & r.Offset(0, -7) & r.Offset(0, -5) & r.Offset(0, -3)
Next r
.Range("a:a,d:d,j:j").Delete
.Range("i1") = "Month"
.Range("j1") = "Index"
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("a1"), SortOn:=xlSortOnValues _
    , Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Range("b1"), SortOn:=xlSortOnValues _
    , Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Range("c1"), SortOn:=xlSortOnValues _
    , Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
    .SetRange Range("a1:j" & tgRw)
    .Header = xlYes
    .MatchCase = False
    .SortMethod = xlPinYin
    .Apply
End With
End With

'Other code
For m = 1 To k
    i = Application.Match(.Cells(m + 6, "a") & .Cells(m + 6, "b") & .Cells(m + 6, "c") & _
        .Cells(m + 6, "d"), rTarget.Offset(0, 9), 0)
    o = Application.CountIf(rTarget.Offset.Offset(0, 9), .Cells(m + 6, "a") & .Cells(m + 6, "b") & .Cells(m + 6, "c") & _
                                    .Cells(m + 6, "d"))
    Set rTgSmall = wsTemp.Range("a1").Offset(i, 0).Resize(o, 1)
    For n = 1 To j * 12
        p = Application.SumIf(rTgSmall.Offset(0, 3), _
            rTgSmall.Offset(0, 1), .Cells(m + 6, "b"), _
            rTgSmall.Offset(0, 2), .Cells(m + 6, "c"), _
            rTgSmall.Offset(0, 4), .Cells(m + 6, "d"), _
            rTgSmall.Offset(0, 7), .Cells(5, n + 5), _
            rTgSmall.Offset(0, 8), .Cells(6, n + 5))
            If p = 0 Then a(m, n) = ""
            If p > 0 Then a(m, n) = p
    Next n
Next m
'Other code

Code: Select all

        p = Application.SumIf(rTgSmall.Offset(0, 3), _
            rTgSmall.Offset(0, 1), .Cells(m + 6, "b"), _
            rTgSmall.Offset(0, 2), .Cells(m + 6, "c"), _
            rTgSmall.Offset(0, 4), .Cells(m + 6, "d"), _
            rTgSmall.Offset(0, 7), .Cells(5, n + 5), _
            rTgSmall.Offset(0, 8), .Cells(6, n + 5))

Code: Select all

o = Application.CountIf(rTarget.Offset.Offset(0, 9), .Cells(m + 6, "a") & .Cells(m + 6, "b") & .Cells(m + 6, "c") & .Cells(m + 6, "d"))