vba code help please!

tinkythomas

tinkythomas

Active Member
Joined
Dec 13, 2006
Messages
432
Hi,

I having problems figuring out what I'm doing wrong with this vba procedure.....
Code: 
Sub ConceptAlign()
    Dim i As Long
    Dim LR As Long
    Application.ScreenUpdating = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Range("H2:H" & LR).Formula = "=TRIM(G2)"
    Range("H2:H" & LR).Copy
    Range("G2").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Columns("H:H").ClearContents
    For i = 1 To LR Step 1
    Select Case Range("G" & i)
    Case "RAMNARBB", "This Lower Level LCN shows up because of the Legacy MSG3 Table", "Data that exist at this level.", _
        "This data is scheduled to be revised with IRCMS analysis to", "replace the existing legacy data.", _
        "The Maintenance Concept for this LCN is located at the next", "higher assembly indenture Level LCN.", _
        "Where applicable Maintenance Significant Consumables will be", "identified in Report 024 Pt2 at its own LCN indenture level", _
        "-----------------------------------------------------------------", _
        "This LCN has been identified as a Maintenance Significant", "Consummable because it is a lifed item:"
        Range("G" & i).Font.ColorIndex = 3
    End Select
    For i = 1 To LR Step 1
    If Range("G" & i).Value Like "*UNSCHEDULED MAINTENANCE*" Then
         .Value = "UNSCHEDULED MAINTENANCE:"
    ElseIf Range("G" & i).Value = "DEPOT LEVEL - SCHEDULED MAINTENANCE" Then
        .Value = "DEPOT LEVEL - SCHEDULED MAINTENANCE:"
    ElseIf Range("G" & i).Value Like "SYSTEM*" Or Range("G" & i).Value Like "*SCHEDULED MAINTENANCE:" Then
        .Font.ColorIndex = 3
    ElseIf Range("G" & i).Value Like "Per Ground Rule*" Then
        .Font.ColorIndex = 3
    ElseIf Range("G" & i).Font.ColorIndex<> 3 Then
        .Value = String(23, " ") & Range("G" & i).Value
    End If
    Next
    Application.ScreenUpdating = True
End Sub
The string "Per Ground Rule" should have font color red after the procedure is run but is not. The reason this string is not within the select case is because sometimes there is additional text but not always! The other strings within the statement are colored red and ok.
Row 118 should have a colon at the end of the string but doesn't. Any string with "UNSCHEDULED MAINTENANCE" should just have 1 colon at the end.

I have been working on this for some time now and just can't see what I'm doing wrong? Any help would be greatly appreciated. Please see a sample of my worksheet.........
CONCEPT.XLS
ABCDEFG
110ss199A29130030010PB57
111ss199A29130030010PB58INTERMEDIATELEVEL-SCHEDULEDMAINTENANCE:
112ss199A29130030010PB59NONE.
113ss199A29130030010PB60
114ss199A29130030010PB61UNSCHEDULEDMAINTENANCE:
115ss199A29130030010PB62NONE.
116ss199A29130030010PB63
117ss199A29130030010PB64
118ss199A29130030010PB65DEPOTLEVEL-SCHEDULEDMAINTENANCE
119ss199A29130030010PB66NONE.
120ss199A29130030010PB67
121ss199A29130030010PB68UNSCHEDULEDMAINTENANCE::
122ss199A29130030010PB69NONE.
123ss199A29130030010010PB1ThisLowerLevelLCNshowsupbecauseoftheLegacyMSG3Table
124ss199A29130030010010PB2Datathatexistatthislevel.
125ss199A29130030010010PB3
126ss199A29130030010010PB4ThisdataisscheduledtoberevisedwithIRCMSanalysisto
127ss199A29130030010010PB5replacetheexistinglegacydata.
128ss199A29130030010010PB6
129ss199A29130030010010PB7TheMaintenanceConceptforthisLCNislocatedatthenext
130ss199A29130030010010PB8higherassemblyindentureLevelLCN.
131ss199A29130030010010PB9
132ss199A29130030010010PB10WhereapplicableMaintenanceSignificantConsumableswillbe
133ss199A29130030010010PB11identifiedinReport024Pt2atitsownLCNindenturelevel
134ss199A29130030010010PB12
135ss199A29130030010010PB13PerGroundRule
136ss199A29130030010010PB14
137ss199A29130030010010PB15
Sheet1
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
How did the "Per Ground Rule" cell start? Any leading spaces? After fixing a couple of compiler errors (two For i's and With missing) , I came up with the following code which writes the modified value to the adjacent cell so that you can compare it with the original and hopefully see why it isn't working. It also uses LTrim to remove leading spaces in the "Per Ground Rule" comparison.

Code: 
    With Range("G" & i)
        If .Value Like "*UNSCHEDULED MAINTENANCE*" Then
             .Offset(0, 1).Value = "UNSCHEDULED MAINTENANCE:"
        ElseIf .Value = "DEPOT LEVEL - SCHEDULED MAINTENANCE" Then
            .Offset(0, 1).Value = "DEPOT LEVEL - SCHEDULED MAINTENANCE:"
        ElseIf .Value Like "SYSTEM*" Or .Value Like "*SCHEDULED MAINTENANCE:" Then
            .Offset(0, 1).Value = .Value
            .Offset(0, 1).Font.ColorIndex = 3
        ElseIf LTrim(.Value) Like "Per Ground Rule*" Then
            .Offset(0, 1).Value = .Value
            .Offset(0, 1).Font.ColorIndex = 3
        ElseIf .Font.ColorIndex <> 3 Then
            .Offset(0, 1).Value = String(23, " ") & .Value
        End If
    End With
 
Upvote 0
How did the "Per Ground Rule" cell start? Any leading spaces? After fixing a couple of compiler errors (two For i's and With missing) , I came up with the following code which writes the modified value to the adjacent cell so that you can compare it with the original and hopefully see why it isn't working. It also uses LTrim to remove leading spaces in the "Per Ground Rule" comparison.

Code: 
    With Range("G" & i)
        If .Value Like "*UNSCHEDULED MAINTENANCE*" Then
             .Offset(0, 1).Value = "UNSCHEDULED MAINTENANCE:"
        ElseIf .Value = "DEPOT LEVEL - SCHEDULED MAINTENANCE" Then
            .Offset(0, 1).Value = "DEPOT LEVEL - SCHEDULED MAINTENANCE:"
        ElseIf .Value Like "SYSTEM*" Or .Value Like "*SCHEDULED MAINTENANCE:" Then
            .Offset(0, 1).Value = .Value
            .Offset(0, 1).Font.ColorIndex = 3
        ElseIf LTrim(.Value) Like "Per Ground Rule*" Then
            .Offset(0, 1).Value = .Value
            .Offset(0, 1).Font.ColorIndex = 3
        ElseIf .Font.ColorIndex <> 3 Then
            .Offset(0, 1).Value = String(23, " ") & .Value
        End If
    End With
Click to expand...

Thanks for your help. I tried the revised code but encountered a runtime error "Method of object global failed". I revised my code to as follows.......
Code: 
Sub ConceptAlign1()
    Dim i  As Long
    Dim LR As Long
    Application.ScreenUpdating = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Range("I2:I" & LR).Formula = "=TRIM(G2)"
    Range("I2:I" & LR).Copy
    Range("G2").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    For i = LR To 1 Step -1
    Select Case Range("G" & i)
    Case "RAMNARBB", "This Lower Level LCN shows up because of the Legacy MSG3 Table", "Data that exist at this level.", _
        "This data is scheduled to be revised with IRCMS analysis to", "replace the existing legacy data.", _
        "The Maintenance Concept for this LCN is located at the next", "higher assembly indenture Level LCN.", _
        "Where applicable Maintenance Significant Consumables will be", "identified in Report 024 Pt2 at its own LCN indenture level", _
        "-----------------------------------------------------------------", _
        "This LCN has been identified as a Maintenance Significant", "Consummable because it is a lifed item:"
        Range("G" & i).Font.ColorIndex = 3
    End Select
    Next
    For i = LR To 1 Step -1
        If Range("G" & i) Like "*UNSCHEDULED MAINTENANCE*" Then
            Range("G" & i) = "UNSCHEDULED MAINTENANCE:"
        ElseIf Range("G" & i) = "DEPOT LEVEL - SCHEDULED MAINTENANCE" Then
            Range("G" & i) = "DEPOT LEVEL - SCHEDULED MAINTENANCE:"
        ElseIf Range("G" & i) Like "SYSTEM*" Or Range("G" & i) Like "*SCHEDULED MAINTENANCE:" Or Range("G" & i) Like "Per Ground Rule*" Then
            Range("G" & i).Font.ColorIndex = 3
        ElseIf Range("G" & i).Font.ColorIndex <> 3 Then
            Range("G" & i) = String(23, " ") & Range("G" & i)
        End If
    Next
    Columns("I:I").ClearContents
    Range("A2").Select
    Application.ScreenUpdating = True
End Sub
everything now works except that "UNSCHEDULED MAINTENANCE:" does not have the 23 leading spaces as it should, even though the font is black. So almost there but not quite!
 
Upvote 0
everything now works except that "UNSCHEDULED MAINTENANCE:" does not have the 23 leading spaces as it should, even though the font is black. So almost there but not quite!
Click to expand...
It won't because "UNSCHEDULED MAINTENANCE:" is matched by the first If clause:

If Range("G" & i) Like "*UNSCHEDULED MAINTENANCE*" Then
Range("G" & i) = "UNSCHEDULED MAINTENANCE:"

which leaves it unchanged. The If...End If statement is completed and it never gets to the line where you add the 23 spaces if the colour isn't red.

You probably want:

If Range("G" & i) Like "*UNSCHEDULED MAINTENANCE*" Then
Range("G" & i) = String(23, " ") & "UNSCHEDULED MAINTENANCE:"
 
Upvote 0
It won't because "UNSCHEDULED MAINTENANCE:" is matched by the first If clause:

If Range("G" & i) Like "*UNSCHEDULED MAINTENANCE*" Then
Range("G" & i) = "UNSCHEDULED MAINTENANCE:"

which leaves it unchanged. The If...End If statement is completed and it never gets to the line where you add the 23 spaces if the colour isn't red.

You probably want:

If Range("G" & i) Like "*UNSCHEDULED MAINTENANCE*" Then
Range("G" & i) = String(23, " ") & "UNSCHEDULED MAINTENANCE:"
Click to expand...
Thank-you so much! The procedure now runs perfectly, thanks again.
 
Upvote 0
You must log in or register to reply here.

Similar threads

zookeepertx
  • Question
Having trouble "deciphering" some code so I can see how it works
Replies
7
Views
216
zookeepertx
zookeepertx
S
  • Question
How to change scope (Workbook to Sheet) of Formula Name after duplicated with Sheet?
Replies
8
Views
843
SunnySchindler
S
I
  • Solved
Current Code taking 10 Hours to run. Need Help to Optimize
Replies
5
Views
375
ItalianPlatinum
I
S
  • Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
410
sspatriots
S
M
  • Question
VBA Code - Run Code if cell value is not blank
Replies
0
Views
503
MHamid
M

Forum statistics

Threads
1,217,365
Messages
6,136,124
Members
449,993
Latest member
Sphere2215

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top