Solved: SIMILAR NUMBERS

[oleg_v]

Hi
I need some Help With a macro.

I need a macro to find 3 similar numbers in column "AB"starting with "AB10 till AB20" than copy the rows that belongs to those numbers to sheet2 starting at "C3"

Thanks

Oleg

[oleg_v]

hi
here is some code that i am working with

[VBA]Public Sub COPYDT()
Const TEST_COLUMN As String = "Ab" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long, NextRow2 As Long
Dim row As Long
NextRow = 1
ROW2 = 6

row = 6
With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).row
'For i = 7 To LastRow
h:
row = 6
row = row + 1
ROW2 = ROW2 + 1

myvar = Sheets("sheet1").Cells(ROW2, 28).Value
If ROW2 = 15 Then
Exit Sub
End If




myvar2 = Sheets("sheet1").Cells(row, 28).Value


If myvar = myvar2 Then

NextRow = NextRow + 1

.Cells(i, "b").Resize(, 27).Copy Worksheets("Sheet2").Cells(NextRow, "d")
onemore1:
NextRow2 = NextRow + 1

.Cells(i, "b").Resize(, 27).Copy Worksheets("Sheet2").Cells(NextRow2, "d")
onemore:

row = row + 1


myvar2 = Sheets("sheet1").Cells(row, 28).Value

If myvar = myvar2 Then
GoTo onemore1



End If

p:
'Next i
GoTo h
End With

End Sub

[/VBA]

[mdmackillop]

Apologies, I totally misread your question. Previous misleading suggestion deleted!

[mdmackillop]

You'll need to adjust the data you wish to copy

[vba]
Sub Test()
Dim Rng As Range
Dim cel As Range
Dim tgt As Range
Dim i As Long
Set tgt = Sheets(2).Range("C3")
Set Rng = Range("AB10:AB20")
For Each cel In Rng
If Application.CountIf(Rng, cel) = 3 Then
cel.Resize(, 10).Copy tgt.Offset(i)
i = i + 1
End If
Next
End Sub
[/vba]

[Bob Phillips]

What does similar mean? They went to the same school, same gender?

[oleg_v]

similar mean "same data in the cell"

i am sorry for my English

[oleg_v]

You'll need to adjust the data you wish to copy

[vba]
Sub Test()
Dim Rng As Range
Dim cel As Range
Dim tgt As Range
Dim i As Long
Set tgt = Sheets(2).Range("C3")
Set Rng = Range("AB10:AB20")
For Each cel In Rng
If Application.CountIf(Rng, cel) = 3 Then
cel.Resize(, 10).Copy tgt.Offset(i)
i = i + 1
End If
Next
End Sub
[/vba]

i can not get it to work

[mdmackillop]

Please post some sample data. I can't test it otherwise

[oleg_v]

attached sample

[mdmackillop]

Correct the target sheet and range to be copied to suit your needs.

[oleg_v]

hi
the macro is working but it does not what asked
i do not complitly understand but what i need is to find similar numbers in column "ab" the to copy the rows that belongs to those numbers meaning if the similar numbers are in "ab11" and "ab20" then copy the rows 11 and 20

thanks

[Blade Hunter]

Change this:

[vba]
Set tgt = Sheets(2).Range("C3")
[/vba]

to
[vba]
Set tgt = Sheets(2).Range("A3")
[/vba]

and

[vba]
cel.Resize(, 10).Copy tgt.Offset(i)
[/vba]

to this
[vba]
cel.row.Copy
tgt.Offset(i).paste
[/vba]

[oleg_v]

hi
this works great
i wanted to ask
why when the rows are being copied the similar rows does not goes one after anther
i sow this when i used this macro to a sheet with 1000 filled rows

[Aussiebear]

You need to create a loop function.

BTW before you ask how, I need to see that you are making an effort to learn VBA here. So here's your challange, Search the Internet about creating a looping function and post the relevant code back here, then we'll offer you any further assistance if required. To this point in time, we continually provide you with assistance you hardly ever provide any code with yours questions to show that you as an individual are attempting to learn anything.

[oleg_v]

hi
i am learning the vba and i have created a loop function and put it in the code
a simplest loop function with a counting numbers and a ''go to" command to a desired label

but i8 can not get the similar data to go one after anther.

[oleg_v]

[VBA]Sub Find()
Dim Found As Range, It
Dim k As Long, t

k = 0
t = 0


y = Sheets("sheet1").Range("q65536").End(xlUp).row
one:
k = k + 1
t = t + 1
myvar = Worksheets("Sheet1").Range("q" & (y - t)).Value
It = myvar 'InputBox("Enter search term")
Set Found = Columns("q").Find(what:=It, LookIn:=xlValues, lookat:=xlWhole)
If Not Found Is Nothing Then
MsgBox It & " found in " & Found.Address(False, False), vbInformation
Else
MsgBox It & " not found.", vbExclamation
End If
Range(Found.Address(False, False)).Select
MsgBox k

Selection.Interior.ColorIndex = k

If t < y Then
GoTo one
Else
Exit Sub
End If


End Sub[/VBA]

[mdmackillop]

Try to avoid GoTo in creating Loops, use one of the inbuilt methods, Do Until....Loop, For Each...Next etc.
For a Find Loop, there is a good example in VBA Help. Understand what it is doing, as you will use it many times.
[vba]


'Example
'This example finds all cells in the range A1:A500 that contain the value 2 and
'changes their values to 5.

With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
[/vba]

[GTO]

Oleg,

Unfortunately, it is off to bed in a bit for this lad, but I kesp staring at this, and it seems to me that we need to take a step back - maybe several steps...

In post #1 and #2, you discuss wanting to copy rows, where we find "3 similar numbers" in Col AB.

In post #17 you offer totally different code that colors a cell in Col Q.

YACK!

The code in the wb at #9 appears (not well checked) to match the code at #2. It fails to compile, as there's a missing End If. Guessing at where to put that in, results in a runtime failure, as with the 'For i = ...' rem'd out, '.Cells(i, "b").... fails, as we're now trying to refer to row zero. This of course results in Excel giving up, which seemed like a good idea to me too...

So... I would respectfully suggest that you may wish to try and describe again what it is we are trying to do.

I am going to guess that your latest code has to do with another bit of the project.

Further - as to the, find 3 similar numbers in column "AB"starting with "AB10 till AB20" than copy the rows that belongs to those numbers to sheet2 starting at "C3"

I am not sure why you are saying to start at row 10, as at least visually, it would seem to start at row 11. Please confirm or correct.

Further - by three similar numbers, might you (from the wb attached @ #9) be referring to the three numbers (2, 3, 5) that have duplicates?

Not sure that his will help, or that I am on course, but hope so,

Mark

[oleg_v]

HI

i am sorry for so many changes but i nearly finish with my project and tomorrow
i will post sample file with a working code

thank you for your notes in the future i will try to be more focused

[GTO]

@Malcom:

Hi Brother,

...there is a good example in VBA Help...
[vba]
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
[/vba]

IMO, I do not think that the help example is all that slick. I use it every so often myself, just because of blonde memory and an easy copy paste, but only because the error is usually not a worry. That said, if 'c' actually becomes Nothing (as it will here after replacing the last '2' with a '5'), then the Loop While... test fails, as of course the c.Address (or Nothing.Address) goes kaboom.

Have a great day :-)

Mark