MyFlight
Technical User
- Feb 4, 2002
- 193
I am using this attached Macro to delete unwanted rwos from my worksheet leaving me with jst the iformation pertaing to what is in the SAVESTR. I run this Macro on multiple Worksheets and the SAVESTR neeeds to change for each one.
I need to be able to change SAVESTR depending on the value in another worksheet. For example if the Value in cell C2 of the "RCM" Workheet is greather than NULL than that value becomes the SAVESTR Variable.
Sub DupShelf()
'
' DupShelf Macro
' Macro Created On by Ralph M. Hill @ Siemens Managed Services Helpdesk
'
'
Const SAVESTR As String = "Main Hub"
Dim sSave As String
Dim myRange As Range
Dim cell As Range
Dim delRange As Range
Sheets("Sheet1").Select
Range("B1").FormulaR1C1 = SAVESTR
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Hardware (10)").Activate
Columns("I:I").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row > 1 Then
Set myRange = Range("I1").Resize(Range( _
"I" & Rows.Count).End(xlUp).Row, 1)
For Each cell In myRange
If cell.Value <> SAVESTR Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then delRange.EntireRow.Delete
Range("B1").Select
Selection.EntireRow.Insert
Else
ActiveWindow.SelectedSheets.Delete
End If
Application.ScreenUpdating = False
End Sub
Any and all suggestions will be appreciated.
I need to be able to change SAVESTR depending on the value in another worksheet. For example if the Value in cell C2 of the "RCM" Workheet is greather than NULL than that value becomes the SAVESTR Variable.
Sub DupShelf()
'
' DupShelf Macro
' Macro Created On by Ralph M. Hill @ Siemens Managed Services Helpdesk
'
'
Const SAVESTR As String = "Main Hub"
Dim sSave As String
Dim myRange As Range
Dim cell As Range
Dim delRange As Range
Sheets("Sheet1").Select
Range("B1").FormulaR1C1 = SAVESTR
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Hardware (10)").Activate
Columns("I:I").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row > 1 Then
Set myRange = Range("I1").Resize(Range( _
"I" & Rows.Count).End(xlUp).Row, 1)
For Each cell In myRange
If cell.Value <> SAVESTR Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then delRange.EntireRow.Delete
Range("B1").Select
Selection.EntireRow.Insert
Else
ActiveWindow.SelectedSheets.Delete
End If
Application.ScreenUpdating = False
End Sub
Any and all suggestions will be appreciated.