I have some code that searches for the text I need copied but I realized that is carrying over formulas. I need it to simply paste the values of the cells. I am not sure how to edit the following to make that happen. Any thoughts?
With Initiatives.Range("B3:B500")
Rcount = 0
For I = LBound(MyArr) To UBound(MyArr)
Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rcount = Rcount + 1
Rng.EntireRow.Copy NewSh.Rows(Rcount)
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
Try modifying the copy code to:
Rng.EntireRow.Copy
NewSh.Cells(RCount,1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
This gives you the option of copying the whole row, and chosing what method of paste you want.
Instead of coping the from a source one range to a destination range
Rng.EntireRow.Copy NewSh.Rows(Rcount)
Have the destination range value = the source ranges value. Just like filling a ranges values using an array.
NewSh.Rows(Rcount).Value = Rng.EntireRow.Value
Related
I have list of ship data in sheet2. First column is ship's name and the others columns are that ship's details. A row below is another ship and so on. What I'm trying to do is copy a row of ship data in sheet1 and paste it to sheet2, but if sheet2 already has that ship i want that ship in sheet2's row replaced with copied one from sheet1.
What I got so far is I copy the row from sheet1 and paste it to sheet2's first avaible empty row and then sort it in alphabetical order :P. So I have lots of rows with the same ship.
Here is my code:
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("sheet1")
Set pasteSheet = Worksheets("sheet2")
copySheet.Range("A5:AT5").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Worksheets("sheet2").Activate
Sheets("sheet2").Range("A2").CurrentRegion.Select
Selection.Sort Key1:=Sheets("sheet2").Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Set Rng = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Here:
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim Rng As Range
Sheets("Sheet1").Range("A5:AT5").Copy ' copies the row mentioned
Sheets("Sheet2").Activate
Set Rng = Range("A:A").Find(What:=Sheets("Sheet1").Range("A5").Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) ' Check to see if ship is already in sheet2 ("Rng = nothing" means it's not, "Rng = [Ship's name]" means it is)
If Not Rng Is Nothing Then 'if it's not nothing, it's somthing (ship's name)
Rng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Pastes over old record of ship
Else
Range("A" & Range("A" & Cells.Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' enters ne entry for ship
End If
Application.CutCopyMode = False
Sheets("sheet2").Range("A2").Sort Key1:=Sheets("sheet2").Range("A1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Set Rng = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
I have modified your code and added a part to find the ship in sheet1 (A5) in sheet2. If found, code will replace the data else add to the end of the data.
Sub CopyShip()
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("sheet1")
Set pasteSheet = Worksheets("sheet2")
Dim rowToCopy As Integer
rowToCopy = 5 ' this variable in case a for loop is implemented in future
Dim findShip As Range
'find current ship in sheet2
Set findShip = pasteSheet.Cells.Find(What:=copySheet.Range("A" & rowToCopy), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
copySheet.Range("A" & rowToCopy & ":AT" & rowToCopy).Copy
If findShip Is Nothing Then
'current ship was not found
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Else
'ship with same name was found
'assuming all data is within columns A to AT
'other wise need to clear the entire row before pasting
pasteSheet.Cells(findShip.Row, 1).PasteSpecial xlPasteValues
End If
Application.CutCopyMode = False
Worksheets("sheet2").Activate
Sheets("sheet2").Range("A2").CurrentRegion.Select
Selection.Sort Key1:=Sheets("sheet2").Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
I'm trying to copy specific columns from one worksheet to another worksheet to make it uniform so I can easily sort and slice the data in other worksheets. I'm having trouble with some columns copying the entire column including blanks. I am searching the header for specific phrases, selecting the entire column (except the header), and copy/pasting to the other worksheet. The problem arises when I get to a column that has blanks - the xlDown feature stops at the blank cell, but if I use xlCellTypeLastCell it selects all of the columns to the right of the column that I want to copy, so I end up overwriting other cells in my other worksheet. Here is a sample of the code I'm using:
' Copy Potential Name
Cells.Find(What:="Potential* Name", After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range(Selection.Offset(1, 0), Cells.SpecialCells(xlCellTypeLastCell)).Select
Selection.Copy
Sheets("Formatted Sheet").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet5").Select
Application.CutCopyMode = False
If I try using a LastRow function; e.g.
LastRow = Sheets("Sheet5").UsedRange.Rows.Count
I can't get it to select the column - it returns an error when I use
Range(Selection.Offset(1, 0), LastRow).Select
Please help!
Thanks in advance
Safer to use End(xlUp) from the bottom of the sheet:
Dim f As Range, rng As Range
Set f = Cells.Find(What:="Potential* Name", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not f Is Nothing Then
With f.Parent
Set rng = .Range(f.Offset(1, 0), .Cells(.Rows.Count, f.Column).End(xlUp))
End With
rng.Copy
Sheets("Formatted Sheet").Range("B2").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
MsgBox "header not found!"
End If
Sheets("Sheet5").Select
Application.CutCopyMode = False
I´m writing a simple macro for searching my value in table. I know that searched value is in the document many times. But my macro finds just first value in table. I want select all rows with the value I´m looking for. Then I want copy selected rows and copy them to "sheet2". Can somebody help me adjust my macro? Thx
Sub Vyhladat()
Sheets("Sheet1").Columns(24).Find(What:=InputBox("Please enter your LR number", "Search")).Select
ActiveCells.EntireRow.Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
Do
If IsEmpty(ActiveCell.Value) Then
ActiveCell.PasteSpecial xlPasteValues
End
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
Here is how to do it (find the first match and then loop with the FindNext() method) :
Sub test_Jean()
Dim FirstAddress As String, _
cF As Range, _
RowsToCopy As String
ActiveSheet.Cells(1, 24).Activate
With ActiveSheet.Columns(24)
'First, define properly the Find method
Set cF = .Find(What:=InputBox("Please enter your LR number", "Search"), _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
'If there is a result, keep looking with FindNext method
If Not cF Is Nothing Then
FirstAddress = cF.Address
Do
cF.EntireRow.Copy
Sheets("Sheet2").Range("A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
Set cF = .FindNext(cF)
'Look until you find again the first result
Loop While Not cF Is Nothing And cF.Address <> FirstAddress
End If
End With
End Sub
i'm having troubles with a Macro that i can't figure it out how to do it, i need a Macro that can scan trough a workbook, Find 3 values, "Data: ", "N°" and "Rodovia:", make a offset of 1 column from them and select that value, and paste it in another sheet like this:
Data: | 10/03/2014
N°: | L02.020.22C
Rodovida: | GO-020
So it must select "10/03/2014", "L02.020.22C" and "GO-020"
I can do it using find and Resize i know, but they are not in the same row or column, they are located in random rows and columns, thats the problem, i tried to use a Range().Select with multiples .Find().offset() inside but it didn't worked
After that i need it to do it with all the cases in the workbook, so i need it to give me that
Case1Data|Case1N°|Case1Rodovia
Case2Data|Case2N°|Case2Rodovia
Case3Data|Case3N°|Case3Rodovia
UPDATE, Code so far:
Sub Gather_Values()
Dim Rng As Range
With Sheets("01").Range("A:AJ")
Set Rng = .Find(What:="Data: ", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Offset(0, 1)
Selection.Copy
Sheets.Add.Name = "New"
Worksheets("New").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
End Sub
This subroutine will collate the 3 values for a single sheet named "01", searching the UsedRange of that sheet:
Sub Gather_Values()
Dim Rng As Range
Dim Sht As Worksheet
'create new worksheet, name it "New"
Set Sht = Sheets.Add
Sht.Name = "New"
'set column titles in the new sheet
Sht.Range("B1").Value = "Data"
Sht.Range("C1").Value = "N°"
Sht.Range("D1").Value = "Rodovia"
'search the entire UsedRange of sheet 01
With Sheets("01").UsedRange
Set Rng = .Find(What:="Data: ", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Offset(0, 1)
Sht.Range("B2").Value = Rng.Value 'put value from the Find into B column of new sheet
Set Rng = .Find(What:="N°", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Offset(0, 1)
Sht.Range("C2").Value = Rng.Value 'put value from the Find into C column of new sheet
Set Rng = .Find(What:="Rodovia:", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Offset(0, 1)
Sht.Range("D2").Value = Rng.Value 'put value from the Find into D column of new sheet
End With
End Sub
If the values appear more than once on a single sheet you will need to determine either what ranges of cells will always contain separate records or come up with a different way of parsing the data to make sure the values you find in sequence are of the same "case" or "record".
It would be helpful to see a sampling of the raw data that you are parsing to see if there is a better way to collate it than using Find(). It would be best to see an instance where there is more than one "case" in the raw data.
I have 2 workbooks. I need copy the row in one workbook only if it contains a certain value from another workbook. Here's my code, it works for the first i=21 and i=22 but tells me there's an error in Cells.Find when I reach i=23.
For i = 21 To 35
Windows("Run Report.xlsm").Activate
Dim strL3 As String
strL3 = Sheets("Summary").Range("A" & i).Value
Workbooks("Ace Survey - Level 1 and level 3 Trending (w Resolution) v3").Activate
Range("A1").Activate
Cells.Find(What:=strL3, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
If strL3 = "Call Disconnected" Or strL3 = "Caller Not Present" Then
ActiveCell.Offset(2, 2).Select
Else
ActiveCell.Offset(1, 2).Select
End If
Application.CutCopyMode = False
ActiveCell.Copy
Windows("Run Report.xlsm").Activate
Sheets("Summary").Select
Range("G" & i).Select
ActiveSheet.Paste
Next i
Find returns a Range object if something is found, but Nothing otherwise. You are attempting to Activate the result of using Find, even if it is Nothing - which will generate an error.
You need to store the result of your Find attempt in a Range variable, and check for Nothing.
Dim rngFound As Range
Set rngFound = Range("A1").Find(...)
If Not rngFound Is Nothing Then
' we found something!
Else
' Nothing
End If
But, as advised, you should be supplying more details for your question.