Need help condensing code

bqheng

New Member
Joined
Sep 20, 2013
Messages
18
Hi, the code that i have gives a "procedure too large" error. I tried breaking it up but have trouble getting the code to flow. I have also thought about condensing the code using For and Next, but have faced issues doing it as well due to the complexity of the code. Can anyone help me with this?

This is part of my long procedure that needs condensing:

after the line where y = y + 1,the red font variables need to increase by 1

VBA Code:
With ws2
    lrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To lrow2
    If .Cells(x, 6) = "" Then
    With ws3
    lrow3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row
    For y = 2 To lrow3
    If ws2.Cells(x, 5) = Left(.Cells(y, 3), 3) And ws2.Cells(x, 5) = Left(.Cells(y + (ws.Range("B8") - 1), 3), 3) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - 1)))) <> 0 Then
    ws2.Cells(x, 6) = Format(Application.WorksheetFunction.Average(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - 1)))), "0.00")
    ws2.Cells(x, 7) = Application.WorksheetFunction.CountA(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - 1))))
    Else
    ws2.Cells(x, 6) = 0
    ws2.Cells(x, 7) = 0
    End If
    
    If ws2.Cells(x, 5) = Left(.Cells(y, 3), 3) And ws2.Cells(x, 5) = Left(.Cells(y + (ws.Range("B8") - 1), 3), 3) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - 1)))) <> 0 And ws.Cells(18, 2) = .Cells(y, 17) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 1 Then
    ws2.Cells(x, 8) = (ws3.Range(aa & y)) / 2
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 2 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) Then
    ws2.Cells(x, 8) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 8) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 3 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) Then
    ws2.Cells(x, 8) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 8) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 4 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 4) Then
    ws2.Cells(x, 8) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 8) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    End If
    End If
    
    y = y + 1
    If ws2.Cells(x, 5) = Left(.Cells(y, 3), 3) And ws2.Cells(x, 5) = Left(.Cells(y + (ws.Range("B8") - [SIZE=5][COLOR=rgb(226, 80, 65)]2[/COLOR][/SIZE]), 3), 3) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - 2)))) <> 0 And ws.Cells([SIZE=5][COLOR=rgb(226, 80, 65)]19[/COLOR][/SIZE], 2) = .Cells(y, 17) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 1 Then
    ws2.Cells(x, [SIZE=5][COLOR=rgb(226, 80, 65)]9[/COLOR][/SIZE]) = (ws3.Range(aa & y)) / 2
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 2 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) Then
    ws2.Cells(x, 9) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 9) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 3 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) Then
    ws2.Cells(x, 9) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 9) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 4 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 4) Then
    ws2.Cells(x, 9) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 9) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    End If
    End If

    y = y + 1
    If ws2.Cells(x, 5) = Left(.Cells(y, 3), 3) And ws2.Cells(x, 5) = Left(.Cells(y + (ws.Range("B8") - 3), 3), 3) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - 3)))) <> 0 And ws.Cells(20, 2) = .Cells(y, 17) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 1 Then
    ws2.Cells(x, 10) = (ws3.Range(aa & y)) / 2
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 2 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) Then
    ws2.Cells(x, 10) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 10) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 3 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) Then
    ws2.Cells(x, 10) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 10) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 4 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 4) Then
    ws2.Cells(x, 10) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 10) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    End If
    End If

    y = y + 1
    If ws2.Cells(x, 5) = Left(.Cells(y, 3), 3) And ws2.Cells(x, 5) = Left(.Cells(y + (ws.Range("B8") - 4), 3), 3) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - 4)))) <> 0 And ws.Cells(21, 2) = .Cells(y, 17) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 1 Then
    ws2.Cells(x, 11) = (ws3.Range(aa & y)) / 2
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 2 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) Then
    ws2.Cells(x, 11) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 11) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 3 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) Then
    ws2.Cells(x, 11) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 11) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 4 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 4) Then
    ws2.Cells(x, 11) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 11) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    End If
    End If

    y = y + 1
    If ws2.Cells(x, 5) = Left(.Cells(y, 3), 3) And ws2.Cells(x, 5) = Left(.Cells(y + (ws.Range("B8") - 5), 3), 3) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - 5)))) <> 0 And ws.Cells(22, 2) = .Cells(y, 17) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 1 Then
    ws2.Cells(x, 12) = (ws3.Range(aa & y)) / 2
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 2 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) Then
    ws2.Cells(x, 12) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 12) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 3 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) Then
    ws2.Cells(x, 12) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 12) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 4 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 4) Then
    ws2.Cells(x, 12) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 12) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    End If
    End If

    y = y + 1
    If ws2.Cells(x, 5) = Left(.Cells(y, 3), 3) And ws2.Cells(x, 5) = Left(.Cells(y + (ws.Range("B8") - 6), 3), 3) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - 6)))) <> 0 And ws.Cells(23, 2) = .Cells(y, 17) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 1 Then
    ws2.Cells(x, 13) = (ws3.Range(aa & y)) / 2
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 2 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) Then
    ws2.Cells(x, 13) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 13) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 3 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) Then
    ws2.Cells(x, 13) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 13) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 4 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 4) Then
    ws2.Cells(x, 13) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 13) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    End If
    End If

    y = y + 1
    If ws2.Cells(x, 5) = Left(.Cells(y, 3), 3) And ws2.Cells(x, 5) = Left(.Cells(y + (ws.Range("B8") - 7), 3), 3) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - 7)))) <> 0 And ws.Cells(24, 2) = .Cells(y, 17) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 1 Then
    ws2.Cells(x, 14) = (ws3.Range(aa & y)) / 2
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 2 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) Then
    ws2.Cells(x, 14) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 14) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 3 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) Then
    ws2.Cells(x, 14) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 14) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 4 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 4) Then
    ws2.Cells(x, 14) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 14) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    End If
    End If

    y = y + 1
    If ws2.Cells(x, 5) = Left(.Cells(y, 3), 3) And ws2.Cells(x, 5) = Left(.Cells(y + (ws.Range("B8") - 8), 3), 3) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - 8)))) <> 0 And ws.Cells(25, 2) = .Cells(y, 17) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 1 Then
    ws2.Cells(x, 15) = (ws3.Range(aa & y)) / 2
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 2 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) Then
    ws2.Cells(x, 15) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 15) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 3 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) Then
    ws2.Cells(x, 15) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 15) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 4 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 4) Then
    ws2.Cells(x, 15) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 15) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    End If
    End If

    y = y + 1
    If ws2.Cells(x, 5) = Left(.Cells(y, 3), 3) And ws2.Cells(x, 5) = Left(.Cells(y + (ws.Range("B8") - 9), 3), 3) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - 9)))) <> 0 And ws.Cells(26, 2) = .Cells(y, 17) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 1 Then
    ws2.Cells(x, 16) = (ws3.Range(aa & y)) / 2
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 2 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) Then
    ws2.Cells(x, 16) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 16) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 3 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) Then
    ws2.Cells(x, 16) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 16) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 4 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 4) Then
    ws2.Cells(x, 16) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 16) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    End If
    End If

    y = y + 1
    If ws2.Cells(x, 5) = Left(.Cells(y, 3), 3) And ws2.Cells(x, 5) = Left(.Cells(y + (ws.Range("B8") - 10), 3), 3) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - 10)))) <> 0 And ws.Cells(27, 2) = .Cells(y, 17) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 1 Then
    ws2.Cells(x, 17) = (ws3.Range(aa & y)) / 2
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 2 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) Then
    ws2.Cells(x, 17) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 17) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 3 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) Then
    ws2.Cells(x, 17) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 17) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 4 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 4) Then
    ws2.Cells(x, 17) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, 17) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    End If
    End If
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
14,559
Office Version
  1. 365
Platform
  1. Windows
the red font variables need to increase by 1
I don't see any variables that you've tried to highlight in red, on the assumption that you mean the numbers which are formatted red by default (which are not actually variables), you could try something like
Rich (BB code):
variable + y - 1
where variable refers to any numeric value of interest in the code.
 
Solution

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,705
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Four things...
1) Update your profile so we know what Office Version and Platform you are using.
2) Properly indent your code so that is more legible.
3) Your code as shown is missing two "End With"
4) Use Option Explicit. If you had you would see that you are missing the two "End With". Which you also would have seen with proper indentation.
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
14,559
Office Version
  1. 365
Platform
  1. Windows
1) Update your profile so we know what Office Version and Platform you are using.
Useful, but irrelevant to the question asked here.
3) Your code as shown is missing two "End With"
If you read post 1 correctly you will see that not all of the code is shown, the missing End With's could be located in the later part of the code that has been omitted from the post.
4) Use Option Explicit. If you had you would see that you are missing the two "End With". Which you also would have seen with proper indentation.
Option Explicit would go into the code before the procedure name, which you will see is not included in the sample code. Therefore it is possible that Option Explicit has already been used and like the End With's above, has simply been omitted from the post.

Additionally, Option Explicit is not required to identify missing End With lines or similar. Those errors would be detected at execution with or without Option Explicit.
 

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,705
Office Version
  1. 365
  2. 2010
Platform
  1. Windows

ADVERTISEMENT

You skipped the part about the indentation. Additionally, if you had taken the time to actually read the code you would have seen where the OP tried to highlight the code in Red. How does you reacting to my post help the OP.
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
14,559
Office Version
  1. 365
Platform
  1. Windows
You skipped the part about the indentation.
That was the only useful part of your post.
How does you reacting to my post help the OP.
It helps about as much as your 3 pointless points that I reacted to, I guess we all have our faults.
Additionally, if you had taken the time to actually read the code you would have seen where the OP tried to highlight the code in Red.
I did, but as you pointed out, the code was badly formatted
after the line where y = y + 1,the red font variables need to increase by 1
y = y + 1 appears 9 times in the code, I missed the one with the attempted highlight.

But it appears that even though I missed it, my assumption and suggested fix are still correct.
 

bqheng

New Member
Joined
Sep 20, 2013
Messages
18
Im sorry if i caused some friction here :( i managed to get it to work by using variables to replace the numbers that needs increasing.

VBA Code:
With ws2
    lrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To lrow2
    If .Cells(x, 6) <> 0 And .Cells(x, 8) = "" Then
    With ws3
    lrow3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row
    xx = 8
    z = 1
    zz = 18
    For y = 2 To lrow3
    If ws2.Cells(x, 5) = Left(.Cells(y, 3), 3) And ws2.Cells(x, 5) = Left(.Cells(y + (ws.Range("B8") - z), 3), 3) Then
    If ws2.Cells(x, 5) = Left(.Cells(y, 3), 3) And ws2.Cells(x, 5) = Left(.Cells(y + (ws.Range("B8") - z), 3), 3) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & ee & (y + (ws.Range("B8") - z)))) <> 0 And ws.Cells(zz, 2) = .Cells(y, 17) Then
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & bb & y)) = 0 Then
    ws2.Cells(x, xx) = 0
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 1 Then
    ws2.Cells(x, xx) = (ws3.Range(aa & y)) / 2
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 2 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) Then
    ws2.Cells(x, xx) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, xx) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 3 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) Then
    ws2.Cells(x, xx) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, xx) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    If WorksheetFunction.CountA(ws3.Range(aa & y & ":" & dd & y)) = 4 Then
    If (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 3) And (Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) * 0.2) > Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 4) Then
    ws2.Cells(x, xx) = Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1) / 2
    Else
    ws2.Cells(x, xx) = Format(Application.WorksheetFunction.Average(Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 1), Application.WorksheetFunction.Large(ws3.Range(aa & y & ":" & dd & y), 2)))
    End If
    End If
    End If
    End If

    xx = xx + 1
    z = z + 1
    zz = zz + 1

    End If
    Next y
    End With
    End If
    Next x
    .Columns("D:AE").HorizontalAlignment = xlCenter
    .Range("A1:AE" & lrow2).Sort key1:=Range("A1:A" & lrow2), _
    order1:=xlAscending, Header:=xlYes
    End With
 

Forum statistics

Threads
1,148,160
Messages
5,745,123
Members
423,927
Latest member
Pra56

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top