Adjusting VBA code for some flexibility

[adidas VBA]

How can I convert this code to say

if value in column E = "CO" then this code
Right now it detects CRJ, ER3 and others in Column J and adds lette E to
everything in Column 3. I would like some additional control on the
code. Help appreciated.


Dim mycounter As Double
Dim c As Range
Dim d As Range
mycounter = 1

Do While mycounter < 35001
Set c = Range("J" & mycounter)
Select Case c.Text
Case Is = "CRJ", "EM2", "ER3", "ER4", "ERD", "ERJ"
Set d = Range("E" & mycounter)
d.Value = d.Value & IIf(Right(d.Text, 1) <> "E", "E", "")
End Select
mycounter = mycounter + 1
Loop


Thanks.

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Trevor Shuttleworth]

Not really sure what you're trying to do but try this as an example:

Sub Macro1()
Dim VisibleRange As Range
Dim c As Range
With Range("A1")
.AutoFilter
.AutoFilter Field:=5, Criteria1:="CO"
Set VisibleRange = _
Intersect(.SpecialCells(xlCellTypeVisible), _
Columns("E"), _
ActiveSheet.UsedRange)
End With
MsgBox VisibleRange.Address
For Each c In VisibleRange
MsgBox c.Address
Next 'c
End Sub

It uses AutoFilter to reduce the number of rows to be processed to just
those with "CO" in column E.

Regards

Trevor

 

[adidas VBA]

Column E has several airline codes (CO, NW, AA, etc.) and I want only CO
to be impacted by my macro. The macro presently applies to all airlines
that operate EMB, CRJ, etc. type aircraft. I want to further narrow the
scope of the macro to only CO which is continental airlines. The macro
will add an E to all CO flights that operate regional jet aircraft such
as EMB, CRJ, others as mentioned in the macro. How can I adjust my
original macro to impact only CO and none of the other airlines?

Thanks.

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[J.E. McGimpsey]

If I understand you correctly:


Dim rCell As Range
For Each rCell In Range("E1:E35000")
With rCell
If .Value = "CO" Then
Select Case .Offset(0, 5).Text
Case "CRJ", "EM2", "ER3", "ER4", "ERD", "ERJ"
.Value = .Value & _
IIf(Right(.Text, 1) <> "E", "E", "")
End Select
End If
End With
Next rCell

 

[adidas VBA]

I think what you have written should work. Once, I check it out I will
post a response and let you know. Thanks a million.

Thanks.

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[adidas VBA]

Presented below is your code incorporated into my macro, but the
question I now have: Can this entire macro be made more efficient
because it takes forever to run? Real slow...needs a boost!! Thanks as
always.

Sub Rest()

Application.ScreenUpdating = False
Application.Calculation = xlManual

Dim RowNdx As Long
For RowNdx = 35000 To 1 Step -1
If Cells(RowNdx, 11).Value = "0" Then
Rows(RowNdx).Delete
End If
Next RowNdx
Dim rCell As Range
For Each rCell In Range("E1:E35000")
With rCell
If .Value = "CO" Then
Select Case .Offset(0, 5).Text
Case "CRJ", "EM2", "ER3", "ER4", "ERD", "ERJ"
.Value = .Value & _
IIf(Right(.Text, 1) <> "E", "E", "")
End Select
End If
End With
Next rCell

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

End Sub


Thanks.

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Trevor Shuttleworth]

My code combined with that from JE should be quicker:

Sub Macro1()
Dim VisibleRange As Range
Dim rCell As Range
With Range("A1")
.AutoFilter
.AutoFilter Field:=5, Criteria1:="CO"
Set VisibleRange = _
Intersect(.SpecialCells(xlCellTypeVisible), _
Columns("E"), _
ActiveSheet.UsedRange)
End With
For Each rCell In VisibleRange
With rCell
If .Value = "CO" Then
Select Case .Offset(0, 5).Text
Case "CRJ", "EM2", "ER3", "ER4", "ERD", "ERJ"
.Value = .Value & _
IIf(Right(.Text, 1) <> "E", "E", "")
End Select
End If
End With
Next rCell
End Sub

You could do a similar thing to filter the 0 cells and delete the rows.
Should also be quicker than looping 35000 times.

Regards

Trevor

 

[adidas VBA]

Trevor, I will test it out and let you know.

Thanks.

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!