PDA

View Full Version : Sleeper: Copying single values instead of range



Alexon2008
05-04-2008, 12:42 PM
I have a listbox on my sheet3. When user doubleclick on one item in listbox then macro start to search for the same value on sheet "input" and when the same value is found then macro copy 20 cells including search value and paste them on sheet3.

I want to change so macro copy single values and paste them on sheet3.
ex. when macro find the same value as in i listbox then macro should copy value in the third cell under searching value and paste it on sheet 3 in cell c3. Then copy the seventh cell under searching value and paste it on sheet3 and cell1. and so on.





Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim rFound As Range
Dim rLook As Range
Dim rValue As String
Dim rDest As Range
If ListBox1.Value = var1 Then Exit Sub
rValue = ListBox1.Value
var1 = rValue
Set rLook = Worksheets("Input").Range("e1:e65000")
Set rFound = rLook.Find(rValue, , , xlWhole)
If Not rFound Is Nothing Then
rFound.Resize(20, 1).Copy
With Worksheets("Sheet3")
With .Range("IV31").End(xlToLeft).Offset(0, 1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteComments
Selection.HorizontalAlignment = xlCenter
End With
End With
End If
End Sub

mikerickson
05-04-2008, 02:57 PM
This is copying a 20 row X 1 column range.

rFound.Resize(20, 1).Copy
This copies a 1Row X 1Column range

rFound.Resize(1, 1).Copy
This copies the one found cell,

rFound.Copy

Alexon2008
05-04-2008, 04:13 PM
I tried this but doesn't work.

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim rFound As Range
Dim rLook As Range
Dim rValue As String
Dim rDest As Range
If ListBox1.Value = var1 Then Exit Sub
rValue = ListBox1.Value
var1 = rValue
Set rLook = Worksheets("Input").Range("e1:e65000")
Set rFound = rLook.Find(rValue, , , xlWhole)
If Not rFound Is Nothing Then
rFound.Resize(20, 1).Copy
With Worksheets("Sheet3").Range("B3")= rFound.Offset(0,2).paste
With Worksheets("Sheet3").Range("B4")= rFound.Offset(0,1).paste
With Worksheets("Sheet3").Range("B5")= rFound.Offset(0,7).paste
With Worksheets("Sheet3").Range("B6")= rFound.Offset(0,5).paste
End With
End With
End If
End Sub

mikerickson
05-04-2008, 06:46 PM
I don't see where the change was made.
Change the line that copies to one of the line's posted above.

mdmackillop
05-05-2008, 12:00 AM
try


Set rFound = rLook.Find(rValue, , , xlWhole)
If Not rFound Is Nothing Then
With Worksheets("Sheet3")
.Range("B3") = rFound.Offset(0, 2).Value
.Range("B4") = rFound.Offset(0, 1).Value
.Range("B5") = rFound.Offset(0, 7).Value
.Range("B6") = rFound.Offset(0, 5).Value
End With
End If

'or

Set rFound = rLook.Find(rValue, , , xlWhole)
If Not rFound Is Nothing Then
With Worksheets("Sheet3")
rFound.Offset(0, 2).Copy .Range("B3")
rFound.Offset(0, 1).Copy .Range("B4")
rFound.Offset(0, 7).Copy .Range("B5")
rFound.Offset(0, 5).Copy .Range("B6")
End With
End If

Alexon2008
05-05-2008, 09:09 AM
mdmack-thank you, it works. But I have one more problem when user select another item in listbox and macro is running again then I want to paste results in next column. So every time macro is runing result should be past in first empty column- starting with column b and cell31.
Here is macro:


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim rFound As Range
Dim rLook As Range
Dim rValue As String
Dim rDest As Range
If ListBox1.Value = var1 Then Exit Sub
rValue = ListBox1.Value
var1 = rValue
Set rLook = Worksheets("Input").Range("e1:e65000")
Set rFound = rLook.Find(rValue, , , xlWhole)
If Not rFound Is Nothing Then
With Worksheets("Sheet3")
.Range("B31") = rFound.Offset(0, 0).Value
.Range("B32") = rFound.Offset(1, 0).Value
.Range("B33") = rFound.Offset(0, 7).Value
.Range("B34") = rFound.Offset(0, 5).Value
End With
End If
End Sub

mdmackillop
05-05-2008, 01:25 PM
Try


Set rLook = Worksheets("Input").Range("e1:e65000")
Set rFound = rLook.Find(rValue, , , xlWhole)
If Not rFound Is Nothing Then
col = .Cells(31, Columns.Count).End(xlToLeft).Column + 1
With Worksheets("Sheet3")
.Cells(31, col) = rFound.Offset(0, 0).Value
.Cells(32, col) = rFound.Offset(1, 0).Value
.Cells(33, col) = rFound.Offset(0, 7).Value
.Cells(34, col) = rFound.Offset(0, 5).Value
End With
End If