-
Find N, leave blank and move down
Hi All,
This macro delete the cell containing the word in a cell and shift the rest of that column up.
[VBA]Sub Find_N_MoveUp()
Dim rFind As Range
Dim rValue As String
Dim rFound As Range
Dim rRange As Range
Dim strFirstAddress As String
Set rRange = ActiveSheet.UsedRange
rValue = InputBox("Enter value to find", "Find all occurences")
With rRange
Set rFind = .Find(rValue, LookIn:=xlValues, lookat:=xlWhole)
If Not rFind Is Nothing Then
strFirstAddress = rFind.Address
Set rFound = rFind
Do
Set rFound = Union(rFound, rFind)
Set rFind = .FindNext(rFind)
Loop While Not rFind Is Nothing And rFind.Address <> strFirstAddress
End If
End With
If Not rFound Is Nothing Then
rFound.Delete Shift:=xlUp
End If[/VBA]
I am wondering if it is possible to modify this macro the way it delete the cell containing the word but leave blank that cell and shift the rest of that column down.
Thanks in advance
Sasa
Last edited by Aussiebear; 01-21-2013 at 03:33 AM.
Reason: Added the correct tags to the supplied code
-
This version will only Clear and not delete:
[VBA]Sub Find_N_MoveUp()
Dim rFind As Range
Dim rValue As String
Dim rFound As Range
Dim rRange As Range
Dim strFirstAddress As String
Set rRange = ActiveSheet.UsedRange
rValue = InputBox("Enter value to find", "Find all occurences")
With rRange
Set rFind = .Find(rValue, LookIn:=xlValues, lookat:=xlWhole)
If Not rFind Is Nothing Then
strFirstAddress = rFind.Address
Set rFound = rFind
Do
Set rFound = Union(rFound, rFind)
Set rFind = .FindNext(rFind)
Loop While Not rFind Is Nothing And rFind.Address <> strFirstAddress
End If
End With
If Not rFound Is Nothing Then
rFound.Clear
End If
End Sub
[/VBA]
This version will Clear and push down:
[VBA]Sub Find_N_MoveUp()
Dim rFind As Range
Dim rValue As String
Dim rFound As Range
Dim rRange As Range
Dim strFirstAddress As String
Set rRange = ActiveSheet.UsedRange
rValue = InputBox("Enter value to find", "Find all occurences")
With rRange
Set rFind = .Find(rValue, LookIn:=xlValues, lookat:=xlWhole)
If Not rFind Is Nothing Then
strFirstAddress = rFind.Address
Set rFound = rFind
Do
Set rFound = Union(rFound, rFind)
Set rFind = .FindNext(rFind)
Loop While Not rFind Is Nothing And rFind.Address <> strFirstAddress
End If
End With
If Not rFound Is Nothing Then
rFound.Clear
rFound.Insert Shift:=xlDown
End If
End Sub
[/VBA]
-
thanks in advance, but what is cleared has to copy down as well. Any help ?
Sasa
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules