#1
|
|||
|
|||
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) thanks in advance. |
#2
|
|||
|
|||
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 |
#3
|
|||
|
|||
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 | |
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 |
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 |