Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Range Compare 1

Status
Not open for further replies.

Bass71

MIS
Jun 21, 2001
79
0
0
Is there a more sophisticated/streamlined way of writing the IF Then stated below, which determines if cells in Cols A-F are identical to the those in the following row and then iterates? For the life of me, I cannot get the Range, Set Range etc syntax down. This is what I've got and it works, but looks so damned cumbersome, I know there's a better way.
Thanks...........RO

Range("F1").Select
Do
If ActiveCell(1, -4).Value = ActiveCell(2, -4).Value And _
ActiveCell(1, -3).Value = ActiveCell(2, -3).Value And _
ActiveCell(1, -2).Value = ActiveCell(2, -2).Value And _
ActiveCell(1, -1).Value = ActiveCell(2, -1).Value And _
ActiveCell(1, 0).Value = ActiveCell(2, 0).Value And _
ActiveCell.Value = ActiveCell(2, 1).Value Then...
Loop Until ActiveCell.Value=""
 

Hi,


Code:
dim rng as range, r as range, iCol as integer, bMatch as boolean
set rng = range([F1], [F1].end(xldown))
for each r in rng
  bMatch = true
  for iCol = -4 to 0 
    with cells(r.row, iCol)
       if .value <> .offset(1).value then
          bMatch = false
          exit for
       end if
    end with
    if bMatch then
      '...
    end if
  next
next



Skip,
[sub]
[glasses] [red]Be Advised![/red] The only distinction between a bird with one wing and a bird with two, is merely...
a difference of A Pinion! [tongue][/sub]
 
Concatenate !!!!!
Code:
EndRow = 'Get last row of data here

For i = 1 to EndRow

If cells(i,1)&cells(i,2)&cells(i,3)&cells(i,4)&cells(i,5)&cells(i,6) = cells(i+1,1)&cells(i+1,2)&cells(i+1,3)&cells(i+1,4)&cells(i+1,5)&cells(i+1,6)

Next i

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question
 
Can't we avoid looping here??

Code:
    Dim r As Range
    Set r = Range("G1:G" & Cells(Rows.Count, "F").End(xlUp).Row - 1)
    r.FormulaR1C1 = "=(RC[-5]=R[1]C[-5])*(RC[-4]=R[1]C[-4])*(RC[-3]=R[1]C[-3])*(RC[-2]=R[1]C[-2])*(RC[-1]=R[1]C[-1])"
    r.Value = r.Value

You could then autofilter for a 1 value and perform your action on that range.

-----------
Regards,
Zack Barresse
 
I like the simplicity of Skip's code however, there's a snag in the following line in <<>> the VB editor states,
"application or object defined error"


dim rng as range, r as range, iCol as integer, bMatch as boolean
set rng = range([F1], [F1].end(xldown))
for each r in rng
bMatch = true
for iCol = -4 to 0
<<<with cells(r.row, iCol)>>>>
if .value <> .offset(1).value then
bMatch = false
exit for
end if
end with
if bMatch then
'...
end if
next
next
 
I wonder why you opt for a less efficient looping routine..??

-----------
Regards,
Zack Barresse
 
Zack - maybe the OP didn't understand all your R1C1's - maybe a bit of an explanation would help......

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question
 
They're pretty well explained in the help files. Basically it's a way to reference cells in a formula according to the area/address of the cell receiving the formula. I guess it could also be done with standard referencing ..

Code:
    Dim r As Range
    Set r = Range("G1:G" & Cells(Rows.Count, "F").End(xlUp).Row - 1)
    r.FormulaR1C1 = "=(B1=B2)*(C1=C2)*(D1=D2)*(E1=E2)*(F1=F2)"
    r.Value = r.Value

Since relative referencing is used, the formula will transfer down.

-----------
Regards,
Zack Barresse
 
I'd use r.Formula instead of r.FormulaR1C1 ...
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top