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
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.
So I have a code that finds three rows and insert the same rows below them, but I need to clear contents of these inserted rows, unfortunately, the selecetion applies for the first three rows and not those inserted.
Sub Add_Timber()
'
' Add_Timber Macro
'
'
Cells.Find(What:="Timber | Zakázky:", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.EntireRow.Copy
Selection.Offset(3, 0).Insert Shift:=xlDown
Cells.Find(What:="Timber | JIRA ID:", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.EntireRow.Copy
Selection.Offset(3, 0).Insert Shift:=xlDown
Cells.Find(What:="Timber | Hodiny:", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.EntireRow.Copy
Selection.Offset(3, 0).Insert Shift:=xlDown
End Sub
So in picture a red block is copied from the previous and I want to delete the data in the NEW INSERTED rows.
Since rows are Always conscutive and in the same ordwer, then you could make copy/insert in one shot
Sub Add_Timber()
Dim f As Range
Set f = Cells.Find(What:="Timber | Zakázky:", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)' try finding "Timber | Zakázky:"
If Not f Is Nothing Then 'if succesfull
With f.Resize(3).EntireRow ' reference found cell row along with its two consecutive ones
.Offset(3).Insert ' insert referenced rows three rows below the referenced ones
.Copy .Offset(3) ' copy referenced rows three rows below
End With
End If
End Sub
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
I'm working with hourly weather data in Excel that has each hour of every day of the year along with the corresponding temperature value that was recorded.
Some of the values weren't recorded, and instead show up as just an "M" on the spreadsheet. For example, A32 = 28, A33 = M, A34 = 30. I want to replace that "M" with a formula to take the average of the previous and next values. I know how to do this manually, but I am having difficulty writing a Macro to find all the M's in the spreadsheet, then auto-replace it as stated above.
My main obstacle is getting excel to use the correct values when replacing the "M".
Here is my code
Sub MReplace()
'
' MReplace Macro
'
'
ActiveCell.Select
Cells.Find(What:="M", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Cells.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(-8, 1).Range("A1").Select
Cells.Find(What:="M", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
, SearchFormat:=False).Activate
Cells.FindNext(After:=ActiveCell).Activate
ActiveCell.Replace What:="M", Replacement:="[****This is what I am having difficulty with****]", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Find(What:="M", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
, SearchFormat:=False).Activate
End Sub
I have heard of something that you can put in to the code that can address the selected cell. I think it's cell() but I am not sure. Maybe that is a way to get it to work better?
Try this code:
Sub MReplace()
Dim ws As Worksheet
Dim cel As Range
Dim firstAddress As String
Set ws = ActiveSheet
Set cel = ws.Range("A:A").Find("M")
If Not cel Is Nothing Then
firstAddress = cel.Address
Do
cel.Value = (cel.Offset(1) + cel.Offset( -1)) / 2
Set cel = ws.Range("A:A").FindNext(cel)
hr = False
If Not cel Is Nothing Then
If cel.Address <> firstAddress Then
hr = True
End If
End If
Loop While hr
End If
End Sub
It loops through all the cells containing "M" and replaces it with the average of the one on the right and the one on the left. It will error on any that are in the first column as there is no column to the left.
I am writing an Excel macro that needs to find specific text Client Remittance Details and then select and cut to the end of the sheet and then paste on another tab. The text can be in on a different row for each different workbook. The macro always writes a specific cell reference so it errors on the next file. Here is the section of the macro that seems to be the error.
Cells.Find(What:="Client Remittance Details", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("A12").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Cut
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
Your Range("A12").Select is ruining your find. This:
Sub luxation()
Dim r1 As Range, rCopy As Range, rPaste As Range
Set r1 = Cells.Find(What:="Client Remittance Details", After:=Cells(1, 1), LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
Set rCopy = Range(r1, Cells.SpecialCells(xlCellTypeLastCell))
Sheets.Add After:=ActiveSheet
Set rPaste = Range("A1")
rCopy.Copy rPaste
End Sub
This sets rPaste to cell A1 on the newly added sheet.