copyt
04-18-2012, 04:25 AM
Hi all, I have a code that can do some calculation for example
Column A
Blank
Blank
Blank
5
3
2
9
8
Blank
100
45
55
25
0
75
2.5
1.5
3.5
The code will find the matches between the first number after blank to the other numbers before next blank
the equation is "x = i + j" then change font in i and j cells to be bold
so the expected results would be
Blank
Blank
Blank
5
3
2
9
8
Blank
100
45
55
25
0
75
2.5
1.5
3.5
My problem is
1. when I run the code all numbers after number 5 will be taken into account to calculate for 5
2. How can I stop the code and go to next 5 if the code found a blank cell?
Any help would be appreciated.
Sub calculation()
Dim finalrow As Long, _
x As Long, _
j As Long, _
i As Long
Dim lngPasteRow As Long
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
For x = 4 To finalrow
For j = x + 1 To finalrow
For i = j + 1 To finalrow
If Cells(x, 1) <> "" And Cells(x - 1, 1) = "" And Cells(x + 1, 1) <> "" Then
If Cells(i, 1) + Cells(j, 1) = Cells(x, 1) Then
With Cells(i, 1).Font
.Bold = True
End With
With Cells(j, 1).Font
.Bold = True
End With
End If
ElseIf Cells(i, 1) Or Cells(j, 1) = "" Then
'Go to next X
End If
Next i
Next j
Next x
MsgBox "Finished"
End Sub
Column A
Blank
Blank
Blank
5
3
2
9
8
Blank
100
45
55
25
0
75
2.5
1.5
3.5
The code will find the matches between the first number after blank to the other numbers before next blank
the equation is "x = i + j" then change font in i and j cells to be bold
so the expected results would be
Blank
Blank
Blank
5
3
2
9
8
Blank
100
45
55
25
0
75
2.5
1.5
3.5
My problem is
1. when I run the code all numbers after number 5 will be taken into account to calculate for 5
2. How can I stop the code and go to next 5 if the code found a blank cell?
Any help would be appreciated.
Sub calculation()
Dim finalrow As Long, _
x As Long, _
j As Long, _
i As Long
Dim lngPasteRow As Long
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
For x = 4 To finalrow
For j = x + 1 To finalrow
For i = j + 1 To finalrow
If Cells(x, 1) <> "" And Cells(x - 1, 1) = "" And Cells(x + 1, 1) <> "" Then
If Cells(i, 1) + Cells(j, 1) = Cells(x, 1) Then
With Cells(i, 1).Font
.Bold = True
End With
With Cells(j, 1).Font
.Bold = True
End With
End If
ElseIf Cells(i, 1) Or Cells(j, 1) = "" Then
'Go to next X
End If
Next i
Next j
Next x
MsgBox "Finished"
End Sub