I need help to create a Excel macro.
Basicly what I have is a sheet full with information about different departments and what I want to do is delete every row EXCEPT the rows that contain some specified values (wich I would like to enter on running the script).
Lets say in the column that names the department (in my sheet named "Avd"), I would want the script to look for any cell that does not contain, for example, the numbers 1, 3, 5, 6 or 21... and so on (i have about 36 different numbers).
I spent a lot of time trying to figure this out and finally got the correct Macro. All you have to do is highlight the information in the column and then run the following Macro. There will be a box that will prompt you what vaule you want to keep. This is good for up to 30,000 rows.
Sub DeleteRows()
Dim strToDelete As String
Dim rngSrc As Range
Dim NumRows As Integer
Dim ThisRow As Integer
Dim ThatRow As Integer
Dim ThisCol As Integer
Dim J As Integer
Dim DeletedRows As Integer
strToDelete = InputBox("Value to Trigger Keep, Jason????", "Delete Rows")
Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)
I have a sort of similar issue, but easier. I have a worksheet that references other worksheets in the workbook. This is a quoting tool I use and so on the configure worksheet, I will select those items I need and the Proposal worksheet has IF statements for all products. Obviously I don't use all products, so I am left with a spread sheet with lots of blank rows. I would like to design a macro that will delete blank rows if the quantity (column N) is blank and to check from row 18-53. Can you help me with that? I am not a programmer and don't know VB, but would like to use the macro instead of having to go back and delete the blank rows every time. Thanks.
Hi Peter, I was looking through a thread and found that you might be able to help me. I am trying to get data from multiple tabs to copy to a front, summary tab. The summary tabs contain a varying number of lines, and lines will get added over time so I will have to copy a large range. Obviously if I just do a straight formula to copy the data across, I will end up with lots of blank lines. Is there a way of removing these blanks by using a macro to copy the data and then remove blanks? or is there some other better way of doing this?
Hi.
I have received an email form somebody but deleted it accidentally so I don't know who was that person and what question had.
Anyway this is what I wrote for my need. Hope it will be useful for you. (Unfortunately I don't have much time to do more for you because I'm very busy man ;)
Option Explicit
'InterlinearDeletion by Piotr Kuchno 08.01.2010
'This macro lets you delete a row that do not contain a specific string
Dim strToKeep As String 'string that let us keep a row that contains it
Dim strToCompare As String 'string taken from a cell(x, y)
Dim rngSrc As Range 'field size to operate, search and delete
Dim numRows As Long 'total number of selected rows to operate, search and delete
Dim selCol As Long 'sel[ected] column
Dim selRow As Long 'sel[ected] row
Dim compOut As Integer 'com[pare] out - returns 0 in case of no match or >0 if there is a match
Dim actRow As Long 'act[ual] row - used temporary in For/Next loop
Dim J As Long 'for For/Next loop
Dim sheetName As String 'keeps sheet's name (different languages have it under different name)
Dim DeletedRows As Long 'just for an information how much rows were deleted
Private Sub cmdStart_Click()
Call InterlinearOperation
End Sub
Private Sub InterlinearOperation()
strToKeep = InputBox("Write a (part of) string you want to keep as a whole row:", "Keep Rows")
If strToKeep = "" Then Exit Sub 'nothing to compare so... exit
'strToKeep = "your string" 'you may use it instead of InputBox window
Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address) 'sets the field size
numRows = rngSrc.Rows.Count 'total number of selected rows
selCol = rngSrc.Column 'selected column
selRow = rngSrc.Row 'selected row
sheetName = ActiveSheet.Name 'reads active sheet's name
DeletedRows = 0 'have to start from the scratch
actRow = selRow 'actRow will change so we need to leave 'selRow' intact
For J = selRow To numRows
strToCompare = Worksheets(sheetName).Cells(actRow, selCol) 'reads a string from cell(x, y)
compOut = InStr(1, strToCompare, strToKeep, vbTextCompare) 'makes comparison and gives its result
If strToCompare = "" Then compOut = 1 'cell(x, y) is empty so lets fool it to not deleting
If compOut = 0 Then 'not found the string we are looking for so...
Worksheets(sheetName).Rows(actRow).Select '...selects actual row,...
Selection.Delete Shift:=xlUp '...deletes it and shifts all rows up
actRow = actRow - 1 'we have one row less so we need to mark this for strToCompare
DeletedRows = DeletedRows + 1 'counts deleted rows
End If
actRow = actRow + 1 'comparison is done so we need to increase this array to give the correct number to strToCompare
Next J
MsgBox "Number of deleted rows: " & DeletedRows
End Sub
I have the same challenge, delete every row except for a specified value in col A. I'd like to use the approach listed for the macro, where you highlight a cell's value to keep, and delete everything else. When I pasted in the macro as shown (I don't know a thing about VBA, this is my first time needing to use it), I get the message box, but no value shown that I highlighted before running the macro. I clicked ok, then got a window, "Microsoft Visual Basic, error 400". Can you help this newbe to get the code to run? I've spend days trying to get sample code to work with no results. Thanks, Jim
- Posts
-
4475
- Registration date
- Thursday January 28, 2010
- Status
- Contributor
- Last seen
- January 6, 2016
757 > kitkathttps://ccm.net/forum/affich-256874-excel-dependant-copying-summary-sheet
May be with slight changes it will do what you want.
I have received an email form somebody but deleted it accidentally so I don't know who was that person and what question had.
Anyway this is what I wrote for my need. Hope it will be useful for you. (Unfortunately I don't have much time to do more for you because I'm very busy man ;)
Option Explicit 'InterlinearDeletion by Piotr Kuchno 08.01.2010 'This macro lets you delete a row that do not contain a specific string Dim strToKeep As String 'string that let us keep a row that contains it Dim strToCompare As String 'string taken from a cell(x, y) Dim rngSrc As Range 'field size to operate, search and delete Dim numRows As Long 'total number of selected rows to operate, search and delete Dim selCol As Long 'sel[ected] column Dim selRow As Long 'sel[ected] row Dim compOut As Integer 'com[pare] out - returns 0 in case of no match or >0 if there is a match Dim actRow As Long 'act[ual] row - used temporary in For/Next loop Dim J As Long 'for For/Next loop Dim sheetName As String 'keeps sheet's name (different languages have it under different name) Dim DeletedRows As Long 'just for an information how much rows were deleted Private Sub cmdStart_Click() Call InterlinearOperation End Sub Private Sub InterlinearOperation() strToKeep = InputBox("Write a (part of) string you want to keep as a whole row:", "Keep Rows") If strToKeep = "" Then Exit Sub 'nothing to compare so... exit 'strToKeep = "your string" 'you may use it instead of InputBox window Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address) 'sets the field size numRows = rngSrc.Rows.Count 'total number of selected rows selCol = rngSrc.Column 'selected column selRow = rngSrc.Row 'selected row sheetName = ActiveSheet.Name 'reads active sheet's name DeletedRows = 0 'have to start from the scratch actRow = selRow 'actRow will change so we need to leave 'selRow' intact For J = selRow To numRows strToCompare = Worksheets(sheetName).Cells(actRow, selCol) 'reads a string from cell(x, y) compOut = InStr(1, strToCompare, strToKeep, vbTextCompare) 'makes comparison and gives its result If strToCompare = "" Then compOut = 1 'cell(x, y) is empty so lets fool it to not deleting If compOut = 0 Then 'not found the string we are looking for so... Worksheets(sheetName).Rows(actRow).Select '...selects actual row,... Selection.Delete Shift:=xlUp '...deletes it and shifts all rows up actRow = actRow - 1 'we have one row less so we need to mark this for strToCompare DeletedRows = DeletedRows + 1 'counts deleted rows End If actRow = actRow + 1 'comparison is done so we need to increase this array to give the correct number to strToCompare Next J MsgBox "Number of deleted rows: " & DeletedRows End Sub