CODEWITHSUNDEEP
excelvba
surendra choudhary
surendra choudhary

Reputation: 65

To make sub-group and find its local maximum value

I'm trying to calculate values in "AQ" Column which are taken from column "AN" as per arrow direction in column "D" If the arrow is this "▲" in column "D", the value in column "AQ" should increase upward and if the arrow is this "▼", the value should increase downward. I've been able to make the following code but not able to use this arrow. few sample is write down in column "AQ". Please help its been 5 hours I'm stuck with this problem

Sub SIZE()
Application.EnableEvents = False
 Dim lastrow As Long
 Dim destSht As Worksheet
 Dim i As Long, j As Long

  With Worksheets("final")
 lastrow = .Range("A" & .Rows.Count).End(xlUp).Row

  'if(k,"D")=Range("A1") then
   For i = 11 To lastrow + 1 'loop whole range (column AN)
    If .Cells(i, "AN") <> "" Then  'If column AN is not empty then
        For j = i To lastrow + 1 'Loop "group" range to find next empty cell. 
       Start from current loop i to last row and add one row to get to next empty cell.
            If .Cells(j, "AN") = "" Then 'When next empty cell is found (i.e. end of small group range) then apply formulas
                   .Cells(i, "AQ").Value = "=MAX(AN" & i & ":AN" & j - 1 & ")"
                Exit For
          End If
        Next j
    End If
  Next I
 End With
Application.EnableEvents = True
End Sub

enter image description here

Upvotes: 0

Views: 55

Answers (1)

Simon
Simon

Reputation: 1375

Something like this?

Sub SIZE()

Application.EnableEvents = False
Dim lastrow As Long
Dim destSht As Worksheet
Dim i As Long, j As Long

Set destSht = Worksheets("final")

With destSht
    lastrow = .Range("A" & .Rows.Count).End(xlUp).Row

    For i = 11 To lastrow + 1 'loop whole range (column AN)
        If .Cells(i, "AN") <> "" Then  'If column AN is not empty then
            For j = i To lastrow + 1 'Loop "group" range to find next empty cell.
                If .Cells(j, "AN") = "" Then 'When next empty cell is found (i.e. end of small group range) then apply formulas
                    If .Cells(i, "D").Value = .Cells(1, "B") Then 'Does it equal the down arrow?
                        .Cells(i, "AQ").Value = "=MAX(AN" & i & ":AN" & j - 1 & ")*-1" 'Make it negative if its down arrow
                    Else
                        .Cells(i, "AQ").Value = "=MAX(AN" & i & ":AN" & j - 1 & ")" 'otherwise positive
                    End If
                    Exit For
                End If
            Next j
        End If
    Next i
End With

Application.EnableEvents = True

End Sub

EDIT:

I have realised what you're trying to actually do. I believe I have it right. Have a go with this code and see if it does what you're after.

Sub SIZE()

Application.EnableEvents = False
Dim lastrow As Long
Dim destSht As Worksheet
Dim i As Long, j As Long
Dim StartRow As Long, EndRow As Long

Set destSht = Worksheets("final")

With destSht
    lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    
    For i = 11 To lastrow
        If .Range("AN" & i) <> "" Then
            If .Range("D" & i) <> .Range("D" & i - 1) Then
                If .Range("D" & i) = .Range("A1") Then
                    For j = i To lastrow
                        If .Range("D" & j) <> .Range("D" & j + 1) Then
                            EndRow = j
                            Exit For
                        End If
                    Next j
                    .Range("AQ" & i).Value = "=MAX(AN" & i & ":AN" & j & ")"
                ElseIf .Range("D" & i) = .Range("B1") Then
                    StartRow = i
                    .Range("AQ" & i).Value = "=MAX(AN" & StartRow & ":AN" & i & ")"
                End If
            Else
                If .Range("D" & i) = .Range("A1") Then
                    .Range("AQ" & i).Value = "=MAX(AN" & i & ":AN" & j & ")"
                ElseIf .Range("D" & i) = .Range("B1") Then
                    .Range("AQ" & i).Value = "=MAX(AN" & StartRow & ":AN" & i & ")"
                End If
            End If
        End If
    Next i
End With
    
Application.EnableEvents = True

End Sub

Upvotes: 1

Related Questions