Previous Topic Next Topic

Formula to copy data

Solved/Closed
swittlin
Posts
1
Registration date
Wednesday March 10, 2010
Status
Member
Last seen
March 10, 2010
 - Mar 10, 2010 at 05:41 PM
venkat1926
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
 - Mar 10, 2010 at 11:02 PM
Hello,
I have a range table that is 18 columns. I want to be able to look up the number in the first column and return all the info in the other 17 columns to a form that also has 17 cells in a row. This is for a gold score card.

My table has dots in each cell ( . .. . .. . . . .. ) these represent strokes per hole. I want to take this from the table and place it on the card. What formula do I use and how is it writen in a macro?

Thanks
Aljar

1 reply

Answer 1 / 1
venkat1926
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
 805
Mar 10, 2010 at 11:02 PM
your database is not clear. you said some dots . I suppose the no. of dots represent the score or soemthing.
what is meant by "return all the info i"
I suppose you want those rows to be copied in anoher sheet e.g. sheet 2
let us see. sample database is like ths in sheet1

hdng1 hdng2 hdng3 hdng4
1 ……… ……… ………
2 ……… ……… ………
3 ……… ……… ………
2 ……… ……… ………
1 ……… ……… ………
1 ……… ……… ………
2 ……… ……… ………
3 ……… ……… ………

try this macro and see whether it solves your problem 

Sub test()
Dim r As Range, rfind As Range
Dim anchor As Range, j As Double, dest As Range
Dim add As String
Worksheets("sheet2").Cells.Clear
Worksheets("sheet1").Activate
Set r = ActiveSheet.UsedRange.Columns("A:A")
Set anchor = Range("A1")
j = InputBox("type the number which you want to refer in the first column")
Set rfind = r.Cells.Find(what:=j, lookat:=xlWhole, after:=anchor)
If rfind Is Nothing Then Exit Sub
add = rfind.Address
rfind.EntireRow.Copy
Set dest = Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial
Do
Set rfind = r.Cells.FindNext(rfind)
If rfind Is Nothing Then Exit Do
If rfind.Address = add Then Exit Do

rfind.EntireRow.Copy
Set dest = Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial
Loop
Application.CutCopyMode = False
MsgBox "macro over"
End Sub
1