Need help condensing code

B

bqheng

New Member
Joined
Sep 20, 2013
Messages
21
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

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
bqheng said:
the red font variables need to increase by 1
Click to expand...
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.
 
Upvote 0
Solution
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.
 
Upvote 0
igold said:
1) Update your profile so we know what Office Version and Platform you are using.
Click to expand...
Useful, but irrelevant to the question asked here.
igold said:
3) Your code as shown is missing two "End With"
Click to expand...
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.
igold said:
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.
Click to expand...
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.
 
Upvote 0
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.
 
Upvote 0
igold said:
You skipped the part about the indentation.
Click to expand...
That was the only useful part of your post.
igold said:
How does you reacting to my post help the OP.
Click to expand...
It helps about as much as your 3 pointless points that I reacted to, I guess we all have our faults.
igold said:
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.
Click to expand...
I did, but as you pointed out, the code was badly formatted
bqheng said:
after the line where y = y + 1,the red font variables need to increase by 1
Click to expand...
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.
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Combining VBA code together...need help!
Replies
3
Views
172
Fluff
Fluff
K
  • Solved
Jump to cell after clicking message box ok
Replies
3
Views
99
dreid1011
dreid1011
I
  • Question
Large file applying formulas via VBA help
Replies
9
Views
265
ItalianPlatinum
I
K
  • Solved
How to copy data from single cells to merge cells and vice versa
2 3
Replies
24
Views
445
Alex Blakenburg
A
S
  • Solved
Import csv file and append to existing table?
Replies
5
Views
637
shellp
S

Forum statistics

Threads
1,215,063
Messages
6,122,927
Members
449,094
Latest member
teemeren

Share this page

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
Back
Top