Microsoft Office Forums change 'Found.EntireRow.Copy' to a # of columns

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 01-06-2017, 11:44 PM
trevorc trevorc is offline change 'Found.EntireRow.Copy' to a # of columns Windows 7 32bit change 'Found.EntireRow.Copy' to a # of columns Office 2013
Competent Performer
change 'Found.EntireRow.Copy' to a # of columns
 
Join Date: Jan 2017
Posts: 117
trevorc will become famous soon enoughtrevorc will become famous soon enough
Default change 'Found.EntireRow.Copy' to a # of columns

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.
Reply With Quote
  #2  
Old 01-07-2017, 08:15 AM
NoSparks NoSparks is offline change 'Found.EntireRow.Copy' to a # of columns Windows 7 64bit change 'Found.EntireRow.Copy' to a # of columns Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 743
NoSparks will become famous soon enoughNoSparks will become famous soon enough
Default

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
Reply With Quote
  #3  
Old 01-08-2017, 12:40 AM
trevorc trevorc is offline change 'Found.EntireRow.Copy' to a # of columns Windows 7 32bit change 'Found.EntireRow.Copy' to a # of columns Office 2013
Competent Performer
change 'Found.EntireRow.Copy' to a # of columns
 
Join Date: Jan 2017
Posts: 117
trevorc will become famous soon enoughtrevorc will become famous soon enough
Default

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
Reply With Quote
Reply

Thread Tools
Display Modes


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
change 'Found.EntireRow.Copy' to a # of columns 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


All times are GMT -7. The time now is 06:24 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2019 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft