Creating LOOP within a macro

[moonlight22]

Hello,
I have recorded a macro which I've modifed to accomplish what I want.
Basically I have a 2 worksheets.
ControlSheet : which has a cell that contains my "criteria" and a button to run the macro
DataSheet: Which holds that data that will be modified based on the macro.

The user is able to enter a value into Cell B3 withing ControlSheet, and when the button his pressed, the row that contains this value in DataSheet is supposed to be deleted.

My macro works, however, this macro only removes one row at a time. Because the value the user entered can appear more than once in the DataSheet, I need all rows that have a cell which contains that value detleted.
I'm unsure how to loop the function in my macro which finds and then deletes the row.

Any help would be great!

(note: there are a couple other actions that are completed at the end of my macro which are part of my requirments but they dont need any modification)

This is my macro:

Sub RR()
'
' RR Macro
'

'
Range("B3").Select
Selection.Copy
Sheets("DataSheet").Select
Cells.Find(what:=Worksheets("ControlSheet").Range("B3").Value, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Range("A1").Select
Sheets("ControlSheet").Select
Selection.Cut
Range("B8").Select
ActiveSheet.Paste
Range("B3").Select
End Sub

 

[Kenneth Hobson]

Always test on a backup copy.

Sub rr()
  Dim f As Range, v As Variant
  With Worksheets("ControlSheet")
    v = .Range("B3").Value
    Set f = FoundRanges(Worksheets("DataSheet").UsedRange, CStr(v))
    If f Is Nothing Then Exit Sub
    f.EntireRow.Delete
    .Select
    .Range("B8").Value = v
    .Range("B3").Value = ""
     .Range("B3").Select
  End With
End Sub

Function FoundRanges(fRange As Range, fStr As String) As Range
  Dim objFind As Range
  Dim rFound As Range, FirstAddress As String
  
  With fRange
    Set objFind = .Find(what:=fStr, After:=fRange.Cells(fRange.Rows.Count, fRange.Columns.Count), _
      LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, MatchCase:=True)
    If Not objFind Is Nothing Then
      Set rFound = objFind
      FirstAddress = objFind.Address
      Do
        Set objFind = .FindNext(objFind)
        If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
      Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
    End If
  End With
  Set FoundRanges = rFound
End Function

 

[moonlight22]

Awesome this works like a gem Kenneth!! Thank you so Much!

A coupble more things acutally that I'd like this macro to do:
- For the search of the value in B3 to be done in a speicifc column in the DataSheet and not the whole sheet (column M)
-To add a condition that will actually cut the delated rows instead of deleting them and paste them into another worksheet
- Have the users name next to the row that was deleted by them in this new worksheet. I'm thinking to add a cell in the controlsheet (say B5) for them to input their name and then that would be copied to the last cell of the they deleted (column I).
- If the user enters a value that is not found they get an error message indicating that it is not there.

Again any help would be much much appreciated!

Always test on a backup copy.

Sub rr()
  Dim f As Range, v As Variant
  With Worksheets("ControlSheet")
    v = .Range("B3").Value
    Set f = FoundRanges(Worksheets("DataSheet").UsedRange, CStr(v))
    If f Is Nothing Then Exit Sub
    f.EntireRow.Delete
    .Select
    .Range("B8").Value = v
    .Range("B3").Value = ""
     .Range("B3").Select
  End With
End Sub

Function FoundRanges(fRange As Range, fStr As String) As Range
  Dim objFind As Range
  Dim rFound As Range, FirstAddress As String
  
  With fRange
    Set objFind = .Find(what:=fStr, After:=fRange.Cells(fRange.Rows.Count, fRange.Columns.Count), _
      LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, MatchCase:=True)
    If Not objFind Is Nothing Then
      Set rFound = objFind
      FirstAddress = objFind.Address
      Do
        Set objFind = .FindNext(objFind)
        If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
      Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
    End If
  End With
  Set FoundRanges = rFound
End Function

 

[Kenneth Hobson]

Normally, it is best to start a new thread for each question. You can always add a link to one that might relate.

For the existence and Column M example, I would use a worksheet change event. Right click the ControlSheet sheet's tab, View Code, and paste:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c As Range, f As Range, rColumnM As Range
  
  Set c = Intersect(Target, Range("B3"))
  If c Is Nothing Then Exit Sub
  If c.Address(False, False) <> "B3" Or IsEmpty(c) Then Exit Sub
  
  With Worksheets("DataSheet")
    Set rColumnM = .Range("M2", .Range("M" & Rows.Count).End(xlUp))
    Set f = FoundRanges(rColumnM, CStr(c.Value2))
    If f Is Nothing Then
      MsgBox c.Value2 & " was not found in DataSheet column M."
      c.Select
      Exit Sub
    End If
  End With
End Sub

Of course the find function posted earlier would be in a Module.