I have data in a sheet and I want to keep a specific section and delete the rest unwanted data based on a specific text search.specific text is dynamic.
So based on Activecell using offset I delete the portion above the specific text and want delete the below portion as well. (Say for example row 56-61 only the data I need, will not be same rows in all sheets)
the current code runs for one worksheet and stops in the second sheet
Sub Test999()
Dim ws As Worksheet, f As Range
For Each ws In Worksheets
Set f = ws.Cells.Find(What:="abc", After:=ActiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not f Is Nothing Then
ws.Range(f.Offset(-2, 0),
ws.Range("A2")).EntireRow.Delete
ws.Range(f, Selection.End(xlDown)).Select
Selection.End(xlDown).Select
ws.Range(ActiveCell.Offset(2, 0),
ws.Range("A500")).EntireRow.Delete
End If
Next ws
End Sub
I want to run this code to all worksheets
There was issue in the Range Selection.
Also be sure that ActiveCell corresponds to the correct cell you want to search from, because activecell can be different in each sheet.
Sub Test999()
Dim ws As Worksheet, f As Range
For Each ws In Worksheets
'Debug.Print ws.Name
Set f = ws.Cells.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not f Is Nothing Then
ws.Activate
ws.Range(f.Offset(-2, 0), ws.Range("A2")).Select
ws.Range(f.Offset(-2, 0), ws.Range("A2")).EntireRow.Delete
f.Select
ws.Range(f, Selection.End(xlDown)).Select
Selection.End(xlDown).Select
ws.Range(ActiveCell.Offset(3, 0), ws.Range("A500")).EntireRow.Delete
End If
Next ws
End Sub
Related
Sub Macro4()
'
' Macro4 Macro
'
' Keyboard Shortcut: Ctrl+Shift+D
'
Dim CellContent0
Dim CellContent1
Dim CellContent2
Dim CellContent3
CellContent0 = ActiveCell.Address
CellContent1 = ActiveCell.Offset(, -4)
CellContent2 = ActiveCell.Offset(, 1)
Sheets("1c").Select
Cells.Find(What:=CellContent1, After _
:=ActiveCell, LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False). _
Activate
Cells.Find(What:=CellContent2, After _
:=ActiveCell, LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False). _
Activate
ActiveCell.Offset(, -1).Copy
Sheets("shipping").Select
Range(CellContent0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Please advice how to fix the code.
I need to copy 2 cells to the left(-4) and right(1) from active cell. Then I go to another sheet and get value based on previous copied cells(-1).
Next I want to move back to previous sheet and paste copied value into initial active cell
For example If I run the macros from cell D7, finally I need to paste copied value to the same cell D7.
Since you do not answer my clarification question, please try the next adapted code which avoids selecting/activating, which only consume Excel resources, slowing the code speed and not bringing any benefit. It copies where your code tried to do it and the same value from clipboard is copied in the initially selected cell:
Sub Macro4()
' Macro4 Macro
' Keyboard Shortcut: Ctrl+Shift+D
Dim CellContent0 As Range, CellContent1 As Range, CellContent2 As Range
Dim ws1C As Worksheet, wsSh As Worksheet, Find1 As Range, Find2 As Range
Set ws1C = Sheets("1c")
Set wsSh = Sheets("shipping")
Set CellContent0 = ActiveCell
Set CellContent1 = CellContent0.Offset(, -4)
Set CellContent2 = CellContent0.Offset(, 1)
Set Find1 = ws1C.cells.Find(What:=CellContent1.value, After _
:=CellContent0, LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Set Find2 = ws1C.cells.Find(What:=CellContent2.value, After _
:=CellContent0, LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not Find2 Is Nothing Then 'if a match has been found:
wsSh.Range(CellContent0.Address).value = Find2.Offset(, -1).value
'now I try copying what I understood from your comment:
CellContent0.value = Find2.Offset(, -1).value
End If
End Sub
Copying only the cell value, no clipboard is necessary, too.
I'm trying to Find "HFM" from every worksheet and if there is one paste some names after that. So the problem is how to avoid adding the names to the sheet when there is no "HFM" in the sheet?
I first had the code without On Error Resume Next but then there is runtime error. When adding that it copies the names to all sheets. Also it returns runtime error if started from sheet that doesn't have "HFM". So how do I fix this?
Dim ws As Worksheet
For Each ws In Worksheets
Cells.Find(What:="HFM", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
On Error Resume Next
ActiveCell.Offset(0, 3).Select
ActiveCell.FormulaR1C1 = "name1"
' etc.
Instead of On Error Resume Next you will have to declare a variable proceed based on result. An Example below.
Dim ws As Worksheet
For Each ws In Worksheets
' Search for a text
Set MyObjectvie = ws.Cells.Find(What:="HFM", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If Not MyObjectvie Is Nothing Then
' if the text is found do the task
MyObjectvie.Offset(0, 3).Value = "name1"
End If
Next ws
I have two sheets:
Database
Macro sheet: It has a row with dates that will be the headings of a table after the macro.
Objective: In the macro sheet take the value of the first date and look for its position in the database sheet. Then, in the database sheet, copy the entire column corresponding to the previously copied date.
I understand that the code should look something like this:
Sheets("Macro").Select
Range("K3").Select
Selection.Copy
Sheets("Database").Select
Cells.Find(What:=Selection.PasteSpecial xlValues, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Macro").Select
ActiveSheet.Paste
This code does not work, because the search part is not done well, I will appreciate some correction
Something along these lines.
Read this to learn the advantages of not using Select or Activate.
When using Find, always check first that your search term is found to avoid an error. For example, you cannot activate a cell that does not exist.
Sub x()
Dim r As Range
With Sheets("Database")
Set r = .Cells.Find(What:=Sheets("Macro").Range("K3").Value, lookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not r Is Nothing Then
Range(r, r.End(xlDown)).Copy Sheets("Macro").Range("A1")
End If
End With
End Sub
Loop through he header dates in the Macro worksheet. If any can be found in the header row of the Database worksheet, copy that column to the Macro worksheet under the header.
sub getDateData()
dim h as long, wsdb as worksheet, m as variant, arr as variant
set wsdb = worksheets("database")
with worksheets("macro")
for h=1 to .cells(1, .columns.count).end(xltoleft).column
m = application.match(.cells(1, h).value2, wsdb.rows(1), 0)
if not iserror(m) then
arr = wsdb.range(wsdb.cells(2, m), wsdb.cells(rows.count, m).end(xlup)).value
.cells(2, h).resize(ubound(arr, 1), ubound(arr, 2)) = arr
end if
next h
end with
end sub
I need to find a text string and store the item names below the text string to put in a different location in the sheet
Example I want to find "Description" and store all the items below it to use later in the macro
And place them in B1 for example
Here's the code im trying to use but I don't know how to store the Active Range
Sub test()
'find description
Cells.Find(What:="Description", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Selection.Offset(1, 0).Select 'Offset after find
Range(Selection, Selection.End(xlDown)).Select 'Selects to end
Dim DescriptionValues As Range
DescriptionValues = Active.Range
ActiveSheet.Range("B10") = DescriptionValues 'put stored text starting in B1
End Sub
Sub test()
Dim rng As Range
Set rng = ActiveSheet.Cells.Find(What:="Description", After:=ActiveSheet.Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not rng Is Nothing Then
Set rng = ActiveSheet.Range(rng.Offset(1, 0), rng.End(xlDown))
ActiveSheet.Range("B1").Resize(rng.Rows, 1).Value = rng.Value 'put stored text starting in B1
End If
End Sub
Sub Macro1()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Cells.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
ActiveCell.Value = "xyz"
Next ws
End Sub
I am using the following code through loop through all the worksheets in an Excel workbook. I want to look for "abc" in a worksheet. If I find "abc" on a particular worksheet I want the value of the cell below it to be set as "xyz".
Example if "abc" is found on Cell A2 of Worksheet1, I want Cell A3 to be "xyz". Similarly, If "abc" is found on cell B4 of Worksheet2, I want Cell B5 to be "xyz". This must be done for the entire workbook. However the looping through the entire workbook does not happen and the code just loops through worksheet1.
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Cells.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
ActiveCell.Value = "xyz"
Next ws