I am trying to find a value "PLGDY", copy data from this row, insert a new row above the one found, paste the data into new row, replace value "PLGDY" with "PLGDN".
I wrote a macro that instead of copying data into new row it pastes into cells to the right. It also changes values in both rows to "PLGDN".
I would like to use For Next loop, because I have plenty of values to change. Is it possible to check how many values to change? I would like to use this number as counter.
Sub Find_and_Change()
'
'Find a "PLGDY" and set an active cell
Cells.Find(What:="PLGDY", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
'select a block of data in a row
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
'copy selected block of data
Selection.Copy
'insert a row above active cell
ActiveSheet.Cells(ActiveCell.Row, 1).Select
ActiveCell.EntireRow.Insert
'set an active cell at the beginig of a row and move into column A
ActiveSheet.Cells(ActiveCell.Row, 1).Select
' paste copied data into this cell
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Now I select whole row
ActiveCell.EntireRow.Select
'I need to replace PLGDY with PLGDN in this row
Selection.Replace What:="PLGDY", Replacement:="PLGDN", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'I need to move active cell 10 columns right and one row down because I want to find next PLGDY
ActiveCell.Offset(1, 10).Select
End Sub
mrbungle's Answer is spot on! Works great.
For anyone finding this and intends to use this code to duplicate rows with multiple values, there is one tweak to be made.
I was able to copy/paste the loop and change the variables to suit, only exception was I needed to add ActiveCell.EntireRow.Selectafter the ActiveCell.EntireRow.Insert otherwise when the second loop came through with the new values it replaced the original value as well as the new row was not selected. Updated code for my purposes is:
Private Sub LT2V()
Dim vCount As Integer
'Add Lesser tier of 2V
vCount = Application.WorksheetFunction.CountIf(Range("D:D"), "2V")
Do Until vCount = 0
Cells.Find(What:="2V", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.EntireRow.Copy
ActiveCell.EntireRow.Insert
ActiveCell.EntireRow.Select
Selection.Replace What:="2V", Replacement:="1V", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveCell.Offset(1, 10).Select
vCount = vCount - 1
Loop
End Sub
You being new I understand you might not know all the shortcuts and built in functions. I still learn new ones all the time. In this case I used the built in worksheet function CountIf to get the number of times the values appear. Then to loop through I like to use Do Until Loop and just subtract 1 through each loop until I reach 0.
Sub Find_and_Change()
vCount = Application.WorksheetFunction.CountIf(Range("A1:Z100"), "PLGDY")
Do Until vCount = 0
Cells.Find(What:="PLGDY", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.EntireRow.Copy
ActiveCell.EntireRow.Insert
Selection.Replace What:="PLGDY", Replacement:="PLGDN", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveCell.Offset(1, 10).Select
vCount = vCount - 1
Loop
End Sub
Related
In a variable selection of cells in single column, I'm needing to swap "Buy" with "Sell", and vice-versa.
I tried something like this...but when first Selection.Replace changes "Sell" to "Buy", then 2nd one just changes "Buy" back to "Sell" -
Data sample
I havent found that I can nest a Selection.Replace..would need to loop down thru each cell somehow?
....
Range("B4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("C4").Select
Selection.PasteSpecial
Selection.Replace What:="Bought", Replacement:="Sold", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Selection.Replace What:="Sold", Replacement:="Bought", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
To achieve what you want, you can replace three times instead of just two times.
The solution shows how to do it, while avoiding the use of Copy, Paste and Select, to make sure we don't interfere with the user selection and the clipboard.
Sub Doit()
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng As Range
Dim Lst As Variant
' Get the range in column B from row 4 and down.
Set Rng1 = Range("B4")
Set Rng2 = Rng1.End(xlDown)
Set Rng = Range(Rng1, Rng2)
' Copy the range to column C
Lst = Rng
Range("C4").Resize(UBound(Lst, 1), UBound(Lst, 2)) = Lst
' Replace Bought with Sold and Sold with Bought
Rng.Replace What:="Bought", Replacement:="#B#o#u#g#h#t", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Rng.Replace What:="Sold", Replacement:="Bought", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Rng.Replace What:="#B#o#u#g#h#t", Replacement:="Sold", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
End Sub
The solution assumes that your data does not contain the string "#B#o#u#g#h#t". You can use whatever string you want instead of "#B#o#u#g#h#t", as long as the string does not appear in your data.
As with your example, the solution does not test, if there is any valid data in Column B from row 4 and down.
ActiveSheet.Range("$A$1:$V$1023").AutoFilter Field:=4, Criteria1:= _
"cancelled"
ActiveSheet.Range("$A$1:$V$1023").AutoFilter Field:=5, Criteria1:="1"
Cells.Find(What:="cancelled", After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(0, 3) = "later"
Cells.Find(What:="cancelled", After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(0, 3).Select
Selection.FillDown
Those are my code. Then I copy pasted it to another worksheet, and the change to "later" disappeared
Rows("1:1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Note that .FillDown Work with a range of cells and not a single cells.
This should work
Sub test()
Dim Foundcell As Range
Set Foundcell = Cells.Find(What:="cancelled", After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Offset(0, 3)
Foundcell.Value = "later"
Range(Foundcell.Address, "D" & ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row).FillDown
End Sub
Output (does this match to your needs) :
For the code you just added It is better to avoid select
Hope this helps, Waiting for your feedbacks
Column A to H has data with some blanks in between. I want to find "ABC" in column A and then select 2 rows above - this will be my ActiveCell.
I want to delete rows in between ActiveCell to Row2 (Active Cell is Dynamic)
Sub format()
Cells.Find(What:="abc", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:= xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False).Activate
ActiveCell.Offset(-2, 0).Select
Range(Selection, ActiveCell, A2).Select
End Sub
The code will do the job for you:
Sub format()
Dim rng As Range
Set rng = Cells.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
rng.Offset(-2, 0).Select
Range(Cells(Selection.Row, 1), Cells(2, 1)).Select
'Selection.EntireRow.Delete
End Sub
Currently I have commented out the last line which will delete the Rows you want. uncomment it, but first be sure that's what you want to delete.
For Range please try:
(ActiveCell, "A2").Select
What i am tryin to do is Copy Data from another workbook into this workbook based on column header names, columns are not in the same sequece and not all columns headers are present on whiuch i hv used on error resume next
i used find function to do it, is there ant other way i can do it.
how can i replace find what in "" with a dynamic range or cell reference
here i is the column from base file which i wanty to find in dump wb
Below is my conding
For i = 1 To 50
Windows("Base.xlsm").Activate
Columns(Columns(i).Address).Select 'i is column number
ActiveSheet.Cells(8, i).Select ' this is required column hader to find
Application.CutCopyMode = False
Selection.copy
Windows("Dump.xlsx").Activate
Rows("2:2").Select
Selection.Find(What:="items", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range(ActiveCell, Cells(ActiveCell.Row + 800000, ActiveCell.Column)).Select
Application.CutCopyMode = False
Selection.copy
Windows("Base.xlsm").Activate
Range("A9").Select 'how to select active cell in the workbook where i want to paste data.
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next i
I understand about 10% of your question. but I'll answer:
how can i replace find what in "" with a dynamic range
you can replace Find(What:="items") with a value of a range, e.g. Find(What:=Range("A1").Value), leaving you with this:
Selection.Find(What:=Range("A1").Value, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
I have a macro :
Sheets("AMEND ESTIMATE").Select
Cells.Find(What:=Sheets("AMEND QUOTE").Range("G4").Value, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(41, 3).Select
Selection.Copy
Sheets("AMEND QUOTE").Select
Range("G4").Offset(14, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'#2
Sheets("AMEND ESTIMATE").Select
Cells.Find(What:=Sheets("AMEND QUOTE").Range("H4").Value, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(41, 3).Select
Selection.Copy
Sheets("AMEND QUOTE").Select
Range("H4").Offset(14, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'#3
Sheets("AMEND ESTIMATE").Select
Cells.Find(What:=Sheets("AMEND QUOTE").Range("I4").Value, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(41, 3).Select
Selection.Copy
Sheets("AMEND QUOTE").Select
Range("I4").Offset(14, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
As you have seen, this macro finds a range from Amend Quote inside AMEND ESTIMATE(worksheets), gets a value and pastes in a certain offset cell in Amend Quote.
This was working fine, but now it is throwing run time error 91.
Can you please help me.
The issue is that your find isn't finding anything. You need to put a bit of error handling to account for when the find returns no result, by setting the result of the find action to a variable and then doing the activate on the variable only if there's something there.
Something like this:
EDIT - updated code below including behaviour to allow the sub to exit if the search term isn't found or if the search term is a zero length string.
I've also tidied up your code a lot to remove 'select then manipulate' - you can manipulate the cells without selecting them first, it'll save a lot of processing time.
Finally I've condensed the whole 50 iterations into a single loop rather than repeating the same action 50 times changing the cell reference by 1 column each time.
Please remember to accept my answer as correct if it helps you.
Sub test()
Dim rng As Range
Dim aEst As Worksheet, aQuo As Worksheet
'Set your sheet names into variables for easier referencing
Set aEst = Sheets("AMEND ESTIMATE")
Set aQuo = Sheets("AMEND QUOTE")
For i = 7 To 57 '7 = Column H, 8 = Column G, etc.
'Set the address of the found value to the rng variable
Set rng = aEst.Cells.Find(What:=aQuo.Cells(4, i).Value, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not rng Is Nothing Then 'CHECK IF THE SEARCH TERM (FROM QUOTE SHEET) WAS FOUND IN THE TARGET SHEET (ESTIMATE)
If Not rng = "" Then 'CHECK IF THE SEARCH TERM WAS A ZERO LENGTH STRING
rng.Offset(41, 3).Copy 'Copy the cell 41 rows down and 3 columns across
aQuo.Cells(4, i).Offset(14, 0).PasteSpecial Paste:=xlPasteValues 'Paste into the cell 14 rows below the original search term in the QUOTE sheet
ElseIf rng = "" Then 'EXIT SUB IF SEARCH TERM WAS A ZERO LENGTH STRING
MsgBox "Work is Done"
Exit Sub
End If
ElseIf rng Is Nothing Then 'EXIT SUB IF SEARCH TERM WAS NOT FOUND IN THE TARGET SHEET
MsgBox "Work is Done"
Exit Sub
End If
Next i 'Move to the next column across and loop
End Sub