Changing Const Variables

[MyFlight]

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.

 

[strongm]

Let's just talk this through a bit: a constant variable that changes ... isn't constant ...

You might want something along the lines of:

Dim SAVESTR As String
SAVESTR = IIf(Range("C2").Value = "", "Main Hub", Range("C2"))

 

[MyFlight]

'Basically I need to sort through all of the rows on a worksheet.
'If the cell value in Column "I" equals the cell value in Cell "B2", then
'I keep the ROW, ELSE DELETE the ROW. Here is what I have so far.
'One NOTE: The Data in Cell C2 has Extra spaces that need to be Trimmed off First.
'I use this to sort through Multiple worksheets changing from Cell Value C2 to C3, C4 etc.

Dim SAVESTR As String

If Sheets("RCM").Range("C2") = "" Then
Else
SAVESTR = Sheets("RCM").Range("C2").Value
End If
Sheets("Hardware (2)").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
Columns("A:A").ColumnWidth = 2
End If
Application.ScreenUpdating = False
End Sub


'Any And all suggestions will be appreciated.

 

[SkipVought]

When Deleting, run the loop from the bottom UP. Otherwise, you tend to loose the reference.

Skip,

_[red][/red]

 

[MyFlight]

SkipVought,

Well, first off I must have the syntax wrong because the TRIM command is not working.

 

[SkipVought]

Where is it. You never posted.

Skip,

_[red][/red]

 

[MyFlight]

Skip,

Sorry, I forgot to mention that the TRIM command should happen on this line:

SAVESTR = Sheets("RCM").Range("C2").Value

I tried the following (not sure if it was correct or not);

Dim TrimString As String
Sheets("Sheet1").Activate
If Sheets("Sheet1").Range("C2") = "" Then
Else
TrimString = Trim(Range("C2"))
SAVESTR = Sheets("Sheet1").Range("C2").Value
EndIf
Sheets("Hardware (2)").Activate
Columns("I:I").Select
On Error Resume Next


Any ideas?

 

[PHV]

As for the TRIM, you may consider something like this:
SAVESTR = Trim(Sheets("RCM").Range("C2").Value)
If SAVESTR = "" Then Exit Sub

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[SkipVought]

Dim TrimString As String, SAVESTR as string

'Sheets("Sheet1").Activate   this is unnecessary if you fully quallify your references

If Trim(Sheets("Sheet1").Range("C2")) <> "" Then
   TrimString = Trim(Sheets("Sheet1").Range("C2"))
   SAVESTR = TrimString 
End If
'Why are you selecting this column?
Sheets("Hardware (2)").Activate
Columns("I:I").Select
'what is this for?
On Error Resume Next

Skip,

_[red][/red]

 

[MyFlight]

Skip,

This was part of a script someone here helped with years ago. It is so i can gi through each row of the spreadheet that has data and compare it to the SAVESTR variable. If the value in Column-I do Not equal SAVESTR the ROW is DELETED.

Since the Data on the Spreadsheet can run to 65000 rows I need to delete the unwanted data. If you need any more clarification please let me know.

 

[SkipVought]

Let's stick to the code that is in question.

What is the question?

Skip,

_[red][/red]

 

[MyFlight]

Skip,

I just found that some of the values in Column-I still have a Space at the end. This is why some of the Macros worked and others did Not. How can I run the TRIM command on all values in column-I?

 

[SkipVought]

Would you please get focused? What does all the code you posted have to do with Column I, except for the next to last statement?

dim r as range

for each r in Sheets("Hardware (2)").Columns("I:I")
  with r
    .value = trim(.value)
  end with
next

Skip,

_[red][/red]

 

[MyFlight]

Skip,

I get a Type Mismatch error here:

.value = trim(.value)

 

[SkipVought]

use the Watch Window or Debug.Print to inspect r.value

Skip,

_[red][/red]

 

[MyFlight]

Skip,

I got it to work this way.

With Sheets("Hardware")
For Each r In Intersect(.Range("I:I"), .UsedRange)
With r
If (Not .HasFormula) And (Not IsNumeric(.Value)) Then
.Value = Trim(.Value)
ElseIf (IsNumeric(.Value)) Then
.Value = Trim(.Value)
End If
End With
Next
End With


thanks for all you help