ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Problem with Range and Occurrences (https://www.excelbanter.com/excel-programming/384322-problem-range-occurrences.html)

Telesphore[_2_]

Problem with Range and Occurrences
 
In Sheets(1) we have these columns: CarOwnerName, LicenceNumbers,
LicenceLetters, AmountPaid, etc..
The licence numbers have 3 letters and 3 numbers.
When a car passes in front of us we would like to identify the owner
informations.
So we enter the 3 numbers in the InputBox.
We would like to 1) copy on Sheets(2) the 5 or 6 cells of the adjacent
columns to the active cell 3 numbers found and 2) check if there are the
same 3 numbers for other clients.

Any help woul be apprecciated. Thank you.

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
Range(ActiveCell.Offset(?, ?), ActiveCell.Offset(?, ?)).Copy
Selection.Copy
Sheets(2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub



Toppers

Problem with Range and Occurrences
 
This copies 7 columns, including active cell i.e. car number to next
available row, starting column A, on sheet2. Change the second number in
RESIZE to alter number of columns copied.

It counts occurences of VAR in Sheets(1) and produces a message if count 1.

HTH

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
With Sheets(1)
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
nextrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
ActiveCell.Resize(1, 7).Copy Sheets(2).Cells(nextrow, 1)
If Application.CountIf(.Range("B:B"), Var) 1 Then
MsgBox Var & " has more than one owner!"
End If
End With
End Sub

"Telesphore" wrote:

In Sheets(1) we have these columns: CarOwnerName, LicenceNumbers,
LicenceLetters, AmountPaid, etc..
The licence numbers have 3 letters and 3 numbers.
When a car passes in front of us we would like to identify the owner
informations.
So we enter the 3 numbers in the InputBox.
We would like to 1) copy on Sheets(2) the 5 or 6 cells of the adjacent
columns to the active cell 3 numbers found and 2) check if there are the
same 3 numbers for other clients.

Any help woul be apprecciated. Thank you.

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
Range(ActiveCell.Offset(?, ?), ActiveCell.Offset(?, ?)).Copy
Selection.Copy
Sheets(2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub




Telesphore[_2_]

Problem with Range and Occurrences
 
Thank you.

It pastes the first occurence in sheet2.
But we would like to paste all other occurences in sheet2.

Thanks again.

"Toppers" This copies 7 columns, including active cell i.e. car number to
next
available row, starting column A, on sheet2. Change the second number in
RESIZE to alter number of columns copied.

It counts occurences of VAR in Sheets(1) and produces a message if count
1.

HTH

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
With Sheets(1)
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
nextrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
ActiveCell.Resize(1, 7).Copy Sheets(2).Cells(nextrow, 1)
If Application.CountIf(.Range("B:B"), Var) 1 Then
MsgBox Var & " has more than one owner!"
End If
End With
End Sub

"Telesphore" wrote:

In Sheets(1) we have these columns: CarOwnerName, LicenceNumbers,
LicenceLetters, AmountPaid, etc..
The licence numbers have 3 letters and 3 numbers.
When a car passes in front of us we would like to identify the owner
informations.
So we enter the 3 numbers in the InputBox.
We would like to 1) copy on Sheets(2) the 5 or 6 cells of the adjacent
columns to the active cell 3 numbers found and 2) check if there are the
same 3 numbers for other clients.

Any help woul be apprecciated. Thank you.

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
Range(ActiveCell.Offset(?, ?), ActiveCell.Offset(?, ?)).Copy
Selection.Copy
Sheets(2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub






Toppers

Problem with Range and Occurrences
 
Try this ... apologies for error in first posting as I realised shortly
afterwards I hadn't coded for all occurences.


Sub SearchSelectCopyPaste()
Dim Var
Dim nbr_rng As Range
On Error Resume Next
With Sheets(1)
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)

lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
Set nbr_rng = .Range("B1:B" & lastrow)
Set c = nbr_rng.Find(Var, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
nextrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
c.Resize(1, 7).Copy Sheets(2).Cells(nextrow, 1)
Set c = nbr_rng.FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

If Application.CountIf(Sheets(1).Range("B:B"), Var) 1 Then
MsgBox Var & " has more than one owner!"
End If

End Sub


"Telesphore" wrote:

Thank you.

It pastes the first occurence in sheet2.
But we would like to paste all other occurences in sheet2.

Thanks again.

"Toppers" This copies 7 columns, including active cell i.e. car number to
next
available row, starting column A, on sheet2. Change the second number in
RESIZE to alter number of columns copied.

It counts occurences of VAR in Sheets(1) and produces a message if count
1.

HTH

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
With Sheets(1)
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
nextrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
ActiveCell.Resize(1, 7).Copy Sheets(2).Cells(nextrow, 1)
If Application.CountIf(.Range("B:B"), Var) 1 Then
MsgBox Var & " has more than one owner!"
End If
End With
End Sub

"Telesphore" wrote:

In Sheets(1) we have these columns: CarOwnerName, LicenceNumbers,
LicenceLetters, AmountPaid, etc..
The licence numbers have 3 letters and 3 numbers.
When a car passes in front of us we would like to identify the owner
informations.
So we enter the 3 numbers in the InputBox.
We would like to 1) copy on Sheets(2) the 5 or 6 cells of the adjacent
columns to the active cell 3 numbers found and 2) check if there are the
same 3 numbers for other clients.

Any help woul be apprecciated. Thank you.

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
Range(ActiveCell.Offset(?, ?), ActiveCell.Offset(?, ?)).Copy
Selection.Copy
Sheets(2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub







Telesphore[_2_]

Problem with Range and Occurrences
 
Thank you again.

Trying to simplify, I have this now which works partially OK:

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
Var = InputBox(Prompt:="What number?", Xpos:=10, Ypos:=10)

Cells.Find(Var).Activate
ActiveCell.EntireRow.Select
Selection.Copy

'Goes to Sheets2 and paste to row A1
Sheets(2).Select
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
'It is OK until here

Application.CutCopyMode = False
End Sub

What is left now is what happens if there are other occurences of Var in
Sheet1?
I suppose I need a Do... Loop

and the new occurences will be paste in A2, A3 and so on on Sheet2l


"Toppers" a écrit dans le message de
news: ...
Try this ... apologies for error in first posting as I realised shortly
afterwards I hadn't coded for all occurences.


Sub SearchSelectCopyPaste()
Dim Var
Dim nbr_rng As Range
On Error Resume Next
With Sheets(1)
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)

lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
Set nbr_rng = .Range("B1:B" & lastrow)
Set c = nbr_rng.Find(Var, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
nextrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
c.Resize(1, 7).Copy Sheets(2).Cells(nextrow, 1)
Set c = nbr_rng.FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

If Application.CountIf(Sheets(1).Range("B:B"), Var) 1 Then
MsgBox Var & " has more than one owner!"
End If

End Sub


"Telesphore" wrote:

Thank you.

It pastes the first occurence in sheet2.
But we would like to paste all other occurences in sheet2.

Thanks again.

"Toppers" This copies 7 columns, including active cell i.e. car number
to
next
available row, starting column A, on sheet2. Change the second number
in
RESIZE to alter number of columns copied.

It counts occurences of VAR in Sheets(1) and produces a message if
count
1.

HTH

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
With Sheets(1)
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
nextrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
ActiveCell.Resize(1, 7).Copy Sheets(2).Cells(nextrow, 1)
If Application.CountIf(.Range("B:B"), Var) 1 Then
MsgBox Var & " has more than one owner!"
End If
End With
End Sub

"Telesphore" wrote:

In Sheets(1) we have these columns: CarOwnerName, LicenceNumbers,
LicenceLetters, AmountPaid, etc..
The licence numbers have 3 letters and 3 numbers.
When a car passes in front of us we would like to identify the owner
informations.
So we enter the 3 numbers in the InputBox.
We would like to 1) copy on Sheets(2) the 5 or 6 cells of the adjacent
columns to the active cell 3 numbers found and 2) check if there are
the
same 3 numbers for other clients.

Any help woul be apprecciated. Thank you.

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
Range(ActiveCell.Offset(?, ?), ActiveCell.Offset(?, ?)).Copy
Selection.Copy
Sheets(2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub









Toppers

Problem with Range and Occurrences
 
My (second posing) code does loop through all occurrences - why did you not
use it "as-is"?

"Telesphore" wrote:

Thank you again.

Trying to simplify, I have this now which works partially OK:

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
Var = InputBox(Prompt:="What number?", Xpos:=10, Ypos:=10)

Cells.Find(Var).Activate
ActiveCell.EntireRow.Select
Selection.Copy

'Goes to Sheets2 and paste to row A1
Sheets(2).Select
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
'It is OK until here

Application.CutCopyMode = False
End Sub

What is left now is what happens if there are other occurences of Var in
Sheet1?
I suppose I need a Do... Loop

and the new occurences will be paste in A2, A3 and so on on Sheet2l


"Toppers" a écrit dans le message de
news: ...
Try this ... apologies for error in first posting as I realised shortly
afterwards I hadn't coded for all occurences.


Sub SearchSelectCopyPaste()
Dim Var
Dim nbr_rng As Range
On Error Resume Next
With Sheets(1)
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)

lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
Set nbr_rng = .Range("B1:B" & lastrow)
Set c = nbr_rng.Find(Var, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
nextrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
c.Resize(1, 7).Copy Sheets(2).Cells(nextrow, 1)
Set c = nbr_rng.FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

If Application.CountIf(Sheets(1).Range("B:B"), Var) 1 Then
MsgBox Var & " has more than one owner!"
End If

End Sub


"Telesphore" wrote:

Thank you.

It pastes the first occurence in sheet2.
But we would like to paste all other occurences in sheet2.

Thanks again.

"Toppers" This copies 7 columns, including active cell i.e. car number
to
next
available row, starting column A, on sheet2. Change the second number
in
RESIZE to alter number of columns copied.

It counts occurences of VAR in Sheets(1) and produces a message if
count
1.

HTH

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
With Sheets(1)
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
nextrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
ActiveCell.Resize(1, 7).Copy Sheets(2).Cells(nextrow, 1)
If Application.CountIf(.Range("B:B"), Var) 1 Then
MsgBox Var & " has more than one owner!"
End If
End With
End Sub

"Telesphore" wrote:

In Sheets(1) we have these columns: CarOwnerName, LicenceNumbers,
LicenceLetters, AmountPaid, etc..
The licence numbers have 3 letters and 3 numbers.
When a car passes in front of us we would like to identify the owner
informations.
So we enter the 3 numbers in the InputBox.
We would like to 1) copy on Sheets(2) the 5 or 6 cells of the adjacent
columns to the active cell 3 numbers found and 2) check if there are
the
same 3 numbers for other clients.

Any help woul be apprecciated. Thank you.

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
Range(ActiveCell.Offset(?, ?), ActiveCell.Offset(?, ?)).Copy
Selection.Copy
Sheets(2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub










Telesphore[_3_]

Problem with Range and Occurrences
 
Thanks again.

I copied the code, but nothing happens.

It does not paste.

"Toppers" a écrit dans le message de
news: ...
My (second posing) code does loop through all occurrences - why did you
not
use it "as-is"?

"Telesphore" wrote:

Thank you again.

Trying to simplify, I have this now which works partially OK:

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
Var = InputBox(Prompt:="What number?", Xpos:=10, Ypos:=10)

Cells.Find(Var).Activate
ActiveCell.EntireRow.Select
Selection.Copy

'Goes to Sheets2 and paste to row A1
Sheets(2).Select
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
'It is OK until here

Application.CutCopyMode = False
End Sub

What is left now is what happens if there are other occurences of Var in
Sheet1?
I suppose I need a Do... Loop

and the new occurences will be paste in A2, A3 and so on on Sheet2l


"Toppers" a écrit dans le message de
news:
...
Try this ... apologies for error in first posting as I realised shortly
afterwards I hadn't coded for all occurences.


Sub SearchSelectCopyPaste()
Dim Var
Dim nbr_rng As Range
On Error Resume Next
With Sheets(1)
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)

lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
Set nbr_rng = .Range("B1:B" & lastrow)
Set c = nbr_rng.Find(Var, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
nextrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
c.Resize(1, 7).Copy Sheets(2).Cells(nextrow, 1)
Set c = nbr_rng.FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

If Application.CountIf(Sheets(1).Range("B:B"), Var) 1 Then
MsgBox Var & " has more than one owner!"
End If

End Sub


"Telesphore" wrote:

Thank you.

It pastes the first occurence in sheet2.
But we would like to paste all other occurences in sheet2.

Thanks again.

"Toppers" This copies 7 columns, including active cell i.e. car
number
to
next
available row, starting column A, on sheet2. Change the second
number
in
RESIZE to alter number of columns copied.

It counts occurences of VAR in Sheets(1) and produces a message if
count
1.

HTH

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
With Sheets(1)
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
nextrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
ActiveCell.Resize(1, 7).Copy Sheets(2).Cells(nextrow, 1)
If Application.CountIf(.Range("B:B"), Var) 1 Then
MsgBox Var & " has more than one owner!"
End If
End With
End Sub

"Telesphore" wrote:

In Sheets(1) we have these columns: CarOwnerName, LicenceNumbers,
LicenceLetters, AmountPaid, etc..
The licence numbers have 3 letters and 3 numbers.
When a car passes in front of us we would like to identify the
owner
informations.
So we enter the 3 numbers in the InputBox.
We would like to 1) copy on Sheets(2) the 5 or 6 cells of the
adjacent
columns to the active cell 3 numbers found and 2) check if there
are
the
same 3 numbers for other clients.

Any help woul be apprecciated. Thank you.

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
Range(ActiveCell.Offset(?, ?), ActiveCell.Offset(?, ?)).Copy
Selection.Copy
Sheets(2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub













All times are GMT +1. The time now is 03:54 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com