change 'Found.EntireRow.Copy' to a # of columns

trevorc · #1 01-06-2017, 11:44 PM

I need to change the code below so that it returns a range of cells rather than the entire row, I need it to return a range of B to K columns for the found row.
found is the search string i'm looking for.

Code:

Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
            If Not Found Is Nothing Then
                FirstAddress = Found.Address
                Do
                    foundNum = foundNum + 1
                    AddressStr = .Name & " " & Found.Address & vbCrLf
                    Set Found = .UsedRange.FindNext(Found)Found.EntireRow.Copy Destination:=Worksheets("instructions").Range("a2" & foundNum)

Can you help?

thanks in advance.

NoSparks · #2 01-07-2017, 08:15 AM

Actually 'myText' is the search string you're looking for.
Found is the single cell range where it's found, from which you get the row.

You need to specify the range to copy, something like

Code:

Range("B" & Found.Row & ":K" & Found.Row).Copy

trevorc · #3 01-08-2017, 12:40 AM

Thanks for the help,
In the end I used the following to resolve the problems

Set Found = .Range("B3:B1000").Find(what:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

and

Worksheets(ws.Name).Range("B2:L2").Copy
Worksheets("instructions").Range("B" & 17 + foundNum).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

this will now only search the cells required and paste the headers for each sheet at the top of rows of data returned from each sheet

searches multiple sheets eccept selected ones, returns the row data for each found value, creates a hyperlink for that row and puts it at the start of the row. it also creates a header row for each sheet were search was found (sample shown using test data prior to implementation)

Sheet & Location Generic ID Storage Location Storage Type
Resistors $B$10 10000.00
Resistors $B$12 100000.00
Resistors $B$13 1000.00
Resistors $B$16 100.00
Sheet & Location Generic ID Storage Location Storage Type
Capacitors $B$4 100
Capacitors $B$6 1000

full button code for anyone interested

Code:

    Dim ws As Worksheet, Found As Range
    Dim myText As String, FirstAddress As String
    Dim AddressStr As String, foundNum As Integer
    myText = Worksheets("instructions").Range("G6")
    If myText = "" Then Exit Sub
    Worksheets("instructions").Range("A16:XX200").Delete
    For Each ws In ThisWorkbook.Worksheets
        With ws
            If ws.Name = "Instructions" Or ws.Name = "Storage Locations" Then GoTo myNext
            t = ws.Name
            Set Found = .Range("B3:B1000").Find(what:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
            If Not Found Is Nothing Then
                If Not foundNum > 1 Then
                    Worksheets("instructions").Range("A17").Value = "Sheet & Location"
                    Worksheets(ws.Name).Range("B2:L2").Copy
                    Worksheets("instructions").Range("B17").Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Else
                    foundNum = foundNum + 1
                    Worksheets("instructions").Range("A" & 17 + foundNum).Value = "Sheet & Location"
                    Worksheets(ws.Name).Range("B2:L2").Copy
                    Worksheets("instructions").Range("B" & 17 + foundNum).Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                End If
                FirstAddress = Found.Address
                Do
                    foundNum = foundNum + 1
                    AddressStr = .Name & " " & Found.Address & vbCrLf
                    addr = Found.Address
                    Set Found = .Range("B3:B1000").FindNext(Found)
                    A = Mid(Found.FindNext.Address, 4, 4)
                    Aa = "$B$"
                    ab = Aa & A
                    row18 = foundNum + 17
                    Found.EntireRow.Copy Destination:=Worksheets("instructions").Range("A" & row18)
                    Worksheets("instructions").Range("Z100") = AddressStr
                    Range("Z100").Copy
                    Range("A" & row18).Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    tt = ws.Name
                    ActiveSheet.Hyperlinks.Add _
                    Anchor:=Worksheets("instructions").Range("A" & row18), _
                                               Address:="", _
                                               SubAddress:=ws.Name + "!" + addr, _
                                               TextToDisplay:=AddressStr
                    Range("A" & row18).Select
                    With Selection.Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With Selection.Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With Selection.Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With Selection.Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                Loop While Not Found Is Nothing And Found.Address <> FirstAddress
            End If
myNext:
        End With
    Next ws
    If Len(AddressStr) Then
    Else:
        MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
    End If
End Sub

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Need to change table to text so that both columns merge to form 1 line	jrasicmark	Word	3	02-24-2015 07:28 AM
Want to change Macro to copy and paste data to new sheet	Vortex69	Excel Programming	0	12-23-2014 09:53 PM
Macro to copy specific columns in Excel from another spreadsheet	KD999	Excel Programming	1	07-20-2012 08:58 AM
quick replace, sort, change columns	userman	Excel	1	05-01-2012 06:24 AM
If two geographical data match in two sheets, copy unique id/code found in one sheet	alliage	Excel	1	09-01-2011 05:23 AM