PDA

View Full Version : Comparing cells within a column



hightide
05-03-2010, 10:13 AM
Hi, im a relative noob to VBA. I am trying to compare two or more cells within a column. For example is any cell in Column A < 7 and is any of the other cells in Column A > 10.
If so I'd like to print a message. The thing is I have a code to do this but it is very long:
e.g
If Range("H5").Value < 10.5 And Range("H5").Value > 6 And Range("H9").Value > 15 And Range("H9").Value < 20 Then
If Range("H6").Value < 10.5 And Range("H6").Value > 6 And Range("H2").Value > 15 And Range("H2").Value < 20 Then
If Range("H9").Value < 10.5 And Range("H9").Value > 6 And Range("H1").Value > 15 And Range("H1").Value < 20 Then
If Range("H2").Value < 10.5 And Range("H2").Value > 6 And Range("H9").Value > 15 And Range("H9").Value < 20 Then

but as you can see it can be very long when there are lots of cells in the column to compare. What I would like is a way of doing the same calculations but with a much shorter code.
Any help would be much appreciated.

mdmackillop
05-03-2010, 10:26 AM
Welcome to VBAX

What message are you needing? Is this just a simple check that at least two cells meet the criteria?

hightide
05-03-2010, 10:46 AM
This is a broader view of my code:

If Range("H5").Value < 10.5 And Range("H5").Value > 6 And Range("H6").Value > 15 And Range("H6").Value < 20 Then
Sheet1.Cells(5, 17) = "matching"

ElseIf Range("H5").Value < 10.5 And Range("H5").Value > 6 And Range("H7").Value > 15 And Range("H7").Value < 20 Then
Sheet1.Cells(5, 17) = "matching"

ElseIf Range("H5").Value < 10.5 And Range("H5").Value > 6 And Range("H8").Value > 15 And Range("H8").Value < 20 Then
Sheet1.Cells(5, 17) = "matching"

ElseIf Range("H5").Value < 10.5 And Range("H5").Value > 6 And Range("H9").Value > 15 And Range("H9").Value < 20 Then
Sheet1.Cells(5, 17) = "matching"

ElseIf Range("H5").Value < 10.5 And Range("H5").Value > 6 And Range("H10").Value > 15 And Range("H10").Value < 20 Then
Sheet1.Cells(5, 17) = "matching"

Else
Sheet1.Cells(5, 17) = ""
End If

If Range("H6").Value < 10.5 And Range("H6").Value > 6 And Range("H5").Value > 15 And Range("H5").Value < 20 Then
Sheet1.Cells(6, 17) = "matching"

ElseIf Range("H6").Value < 10.5 And Range("H6").Value > 6 And Range("H7").Value >15 And Range("H7").Value < 20 Then
Sheet1.Cells(6, 17) = "matching"

ElseIf Range("H6").Value < 10.5 And Range("H6").Value > 6 And Range("H8").Value >15 And Range("H8").Value < 20 Then
Sheet1.Cells(6, 17) = "matching"

ElseIf Range("H6").Value < 10.5 And Range("H6").Value > 6 And Range("H9").Value > 15 And Range("H9").Value < 20 Then
Sheet1.Cells(6, 17) = "matching"

ElseIf Range("H6").Value < 10.5 And Range("H6").Value > 6 And Range("H10").Value > 15 And Range("H10").Value < 20 Then
Sheet1.Cells(6, 17) = "matching"

Else
Sheet1.Cells(6, 17) = ""
End If

If Range("H7").Value < 10.5 And Range("H7").Value > 6 And Range("H5").Value > 15 And Range("H5").Value < 20 Then
Sheet1.Cells(7, 17) = "matching"

ElseIf Range("H7").Value < 10.5 And Range("H7").Value > 6 And Range("H6").Value > 15 And Range("H6").Value < 20 Then
Sheet1.Cells(7, 17) = "matching"

ElseIf Range("H7").Value < 10.5 And Range("H7").Value > 6 And Range("H8").Value > 15 And Range("H8").Value < 20 Then
Sheet1.Cells(7, 17) = "matching"

ElseIf Range("H7").Value < 10.5 And Range("H7").Value > 6 And Range("H9").Value > 15 And Range("H9").Value < 20 Then
Sheet1.Cells(7, 17) = "matching"

ElseIf Range("H7").Value < 10.5 And Range("H7").Value > 6 And Range("H10").Value > 15 And Range("H10").Value < 20 Then
Sheet1.Cells(7, 17) = "matching"

Else
Sheet1.Cells(7, 17) = ""
End If

If Range("H8").Value < 10.5 And Range("H8").Value > 6 And Range("H5").Value > 15 And Range("H5").Value < 20 Then
Sheet1.Cells(8, 17) = "matching"

ElseIf Range("H8").Value < 10.5 And Range("H8").Value > 6 And Range("H6").Value > 15 And Range("H6").Value < 20 Then
Sheet1.Cells(8, 17) = "matching"

ElseIf Range("H8").Value < 10.5 And Range("H8").Value > 6 And Range("H7").Value >15 And Range("H7").Value < 20 Then
Sheet1.Cells(8, 17) = "matching"

ElseIf Range("H8").Value < 10.5 And Range("H8").Value > 6 And Range("H9").Value > 15 And Range("H9").Value < 20 Then
Sheet1.Cells(8, 17) = "matching"

ElseIf Range("H8").Value < 10.5 And Range("H8").Value > 6 And Range("H10").Value > 15 And Range("H10").Value < 20 Then
Sheet1.Cells(8, 17) = "matching"

Else
Sheet1.Cells(8, 17) = ""
End If

etc, etc, etc


any help help to write ashorter code would be very much appreciated

mdmackillop
05-03-2010, 11:42 AM
Can you post a sample file showing your data layout. Use Manage Attachments in the Go Advanced reply section

rbrhodes
05-04-2010, 04:07 AM
Hi high,

shorter.

Commented and easy to maintain

Can't say I understand the logic tho...





Option Explicit

Sub CompareH()

Dim i As Long
Dim j As Long
Dim sRow As Long
Dim eRow As Long
Dim cCol As Long
Dim rCol As Long

'//User change
sRow = 5 'Start row
eRow = 10 'End row
cCol = 8 'Check col (8 = H)
rCol = 17 'Results col (17 = Q)
'//End User change

'Speed and recursion
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Clear old: based on what we're told here
Range(Cells(sRow, rCol).Address, Cells(eRow, rCol).Address).ClearContents

'Check all rows
For i = sRow To eRow
'If Col/row number) qualifies
If Cells(i, cCol) > 6 And Cells(i, cCol) < 10.5 Then
'then check against Col/all rows
For j = sRow To eRow
'If Col/row number qualifies
If Cells(j, cCol) > 15 And Cells(j, cCol) < 20 Then
'Put 'matching' in Col/row number
Cells(i, rCol) = "Matching"
End If
'Else check next Col/row number
Next j
End If
'Check Col/next row number
Next i

'Reset
With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub