VBA Code Help?

D

dkenebre

I am having a problem with the code below.
Stepping-thru the code here's what seems to be happening at the 2nd
iteration (row 32):

1] Check the value of AG32 (231) and via the Case Select, go 1st to sub
highest, then to sub second_highest
2] At sub highest, check each value in the range of G32:p32 for a match
with AA32. At the time of execution, these values are:
5-2-5-0-5-1-6-2-4-6 checked against 6, resulting in matches in M32 and
P32.
3] The variable answer is concatenated at each match, from the row 13
up from the check row, in this case, row 19. At execution, row 19,
cells G19:p19 hold:
5-2-7-0-5-1-9-2-4-6
4] Matching at M & P yield a partial result to answer of "9" & "6", for
"96"
5] The process is then repeated for second_highest sub as above, except
the match cell is AC32, which holds 5.
6] Given the array in G32:p32 in 2] above, and given that AC32 holds 5,
the matches in this sub occur at G32, I32 and K32.
7] Offsetting 13 rows to G19, I19 and K19 result in the values 5, 7 and
5.
8] Concatenating with the value from the sub highest, you get:
answer="96" & "5" & "7" & "5", or "96575"

Therefore, in my chart example, These are the results occurring versus
the results that should be occurring:

1st iteration: Q7= 629 ans is correct (Q7 gets results from G19-P19)
2nd iteration: Q20= 96575 ans should be 69024 (Q20 gets results from
G32-P32)
3rd iteration: Q33= 422 ans should be 871 (Q33 gets results from
G45-P45)
4th iteration: Q46= 7213 ans should be 8256 (Q7 gets results from
G58-P58)
The results I am looking for example is the following:
#1 through #6 and #8 is correct. Therefore, the answer should be
96(M32 and P32) + 024 (G32, I32 and K32) or 96024 not 96575.
The answer in Q20 has no relationship to the values in G19 through P19,
only to G32 through P32.
So #7 may be a problem, because this 2nd iteration results are not
related to anything in G19 though P19.
Either download the chart or copy the code below. Maybe someone can
help me adjust the code to get the correct results. Thanks.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim i As Integer

'make whole sheet the target
If Target.Column > 0 Then

'see what lookup code has been generated and
'run either max/2nd/3rd highest numbers subroutines

For i = 19 To 1319 Step 13
'clear previous answer
answer = ""

Select Case Worksheets("combo").Range("AG" & i).Value

Case 111
Call highest(i, answer)
Call second_highest(i, answer)
Call third_highest(i, answer)
Case 112
Call highest(i, answer)
Call second_highest(i, answer)
Call third_highest(i, answer)
Case 113
Call highest(i, answer)
Call second_highest(i, answer)
Call third_highest(i, answer)
Case 114 To 118
Call highest(i, answer)
Call second_highest(i, answer)
Case 121 To 127
Call highest(i, answer)
Call second_highest(i, answer)
Case 131 To 136
Call highest(i, answer)
Call second_highest(i, answer)
Case 141 To 145
Call highest(i, answer)
Call second_highest(i, answer)
Case 211 To 217
Call highest(i, answer)
Call second_highest(i, answer)
Case 221 To 226
Call highest(i, answer)
Call second_highest(i, answer)
Case 231 To 235
Call highest(i, answer)
Call second_highest(i, answer)
Case 241 To 244
Call highest(i, answer)
Case 311 To 316
Call highest(i, answer)
Call second_highest(i, answer)
Case 411 To 460
Call highest(i, answer)
Case 511 To 550
Call highest(i, answer)
'case else : theres a few permutations not covered
'the missing ones will spit out an error message
Case Else
answer = "error"
End Select


'put the final answer in merged cell Q7
Worksheets("combo").Range("Q" & (i - 12)).Value = answer
Next i

End If
End Sub
Sub highest(i As Integer, answer As Variant)
'checking each cell in the total line in turn
For Each cell In Worksheets("combo").Range("G" & i & ":p" & i)
'if its equal to the value of the max value
If cell.Value = Worksheets("combo").Range("AA" & i).Value Then
'tack on the value of the heading to the existing value of the
answer
answer = answer & cell.Offset(-13, 0).Value
End If
Next cell
End Sub
Sub second_highest(i As Integer, answer As Variant)
For Each cell In Worksheets("combo").Range("G" & i & ":p" & i)
'if its equal to the value of the 2nd highest value
If cell.Value = Worksheets("combo").Range("AC" & i).Value Then
answer = answer & cell.Offset(-13, 0).Value
End If
Next cell
End Sub
Sub third_highest(i As Integer, answer As Variant)
For Each cell In Worksheets("combo").Range("G" & i & ":p" & i)
'if its equal to the value of the 3rd highest value
If cell.Value = Worksheets("combo").Range("AE" & i).Value Then
answer = answer & cell.Offset(-13, 0).Value
End If
Next cell
End Sub

File Attached: http://www.excelforum.com/attachment.php?postid=319789 (q2 a3.xls)
 
D

dkenebre

Okay I got this problem to work using the following code update. Also,
you can look at the updated attachment, if necessary.

Now to complete this chart I need to either update this macro
or create another macro that executes the same function as the
highest values for the lowest values and place the result in the
corresponding S column, starting with S7, like Q7 with the highest
values. How do you suggest I do that?

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
On Error GoTo Xit

Dim i As Long, answer As String, LastRow As Long

LastRow = [B65536].End(xlUp).Row

'see what lookup code has been generated and
'run either max/2nd/3rd highest numbers subroutines

For i = 19 To LastRow + 1 Step 13
'clear previous answer
answer = ""

Select Case Worksheets("combo").Range("AG" & i).Value

Case 111
Call highest(i, answer)
Call second_highest(i, answer)
Call third_highest(i, answer)
Case 112
Call highest(i, answer)
Call second_highest(i, answer)
Call third_highest(i, answer)
Case 113
Call highest(i, answer)
Call second_highest(i, answer)
Call third_highest(i, answer)
Case 114 To 118
Call highest(i, answer)
Call second_highest(i, answer)
Case 121 To 127
Call highest(i, answer)
Call second_highest(i, answer)
Case 131 To 136
Call highest(i, answer)
Call second_highest(i, answer)
Case 141 To 145
Call highest(i, answer)
Call second_highest(i, answer)
Case 211 To 217
Call highest(i, answer)
Call second_highest(i, answer)
Case 221 To 226
Call highest(i, answer)
Call second_highest(i, answer)
Case 231 To 235
Call highest(i, answer)
Call second_highest(i, answer)
Case 241 To 244
Call highest(i, answer)
Case 311 To 325
Call highest(i, answer)
Call second_highest(i, answer)
Case 331 To 334
Call highest(i, answer)
Case 411 To 460
Call highest(i, answer)
Case 511 To 550
Call highest(i, answer)
'case else : theres a few permutations not covered
'the missing ones will spit out an error message
Case Else
answer = "error"
End Select

'put the final answer in merged cell Q7
Worksheets("combo").Range("Q" & (i - 12)).Value = answer
answer = ""

Next i

Xit:
Application.EnableEvents = True

End Sub
Sub highest(i As Long, answer As String)
'checking each cell in the total line in turn
Dim j As Integer
j = 0
For Each cell In Worksheets("combo").Range("G" & i & ":p" & i)
j = j + 1
'if its equal to the value of the max value
If cell.Value = Worksheets("combo").Range("AA" & i).Value Then
'tack on the value of the heading to the existing value of the
answer
answer = answer & Cells(6, 6 + j).Value
End If
Next cell
End Sub
Sub second_highest(i As Long, answer As String)
Dim j As Integer
j = 0
For Each cell In Worksheets("combo").Range("G" & i & ":p" & i)
j = j + 1
'if its equal to the value of the 2nd highest value
If cell.Value = Worksheets("combo").Range("AC" & i).Value Then
answer = answer & Cells(6, 6 + j).Value
End If
Next cell
End Sub
Sub third_highest(i As Long, answer As String)
Dim j As Integer
j = 0
For Each cell In Worksheets("combo").Range("G" & i & ":p" & i)
j = j + 1
'if its equal to the value of the 3rd highest value
If cell.Value = Worksheets("combo").Range("AE" & i).Value Then
answer = answer & Cells(6, 6 + j).Value
End If
Next cell
End Sub

File Attached: http://www.excelforum.com/attachment.php?postid=321142 (q2 a3 (1).xls)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top