Search a Range for changing Text

[Boham2000]

It has been some time since I had to do some programming however; I am muttling through this project that I've been given. I am stumped at the moment and would appreciate some guidance from you guys. I have the following table and have my script to identify a change in software title and assign the start row and end row as the range for column c. I now need to search this range for the word "core", "standard", "approved" and if found replace all occurances of "prohibited" and "new" with the found word. For example for the Software Title "1-2-3", MyRange is C2:C6, and Prohibited and New would be replaced by Core.

Software Title	Status
1-2-3	Prohibited
1-2-3	Prohibited
1-2-3	Core
1-2-3	New
1-2-3	Prohibited

<tbody>
</tbody><colgroup><col><col></colgroup>

My code thus far is:
Sub Compare_Cells()
Dim i, FirstRow, LastRow, A, B, C As Integer
Dim r As Long
Dim firstTime As Integer
Dim bNotFound As Boolean
Dim String1, String2, String3, String4, String5, String6, Txt As String
Dim Status As Range

i = 2
FirstRow = i
LastRow = i - 1
bNotFound = True

Do While bNotFound
FirstRow = LastRow + 1
String1 = Worksheets("Sheet1").Cells(i, "B").Value

If String1 = "" Then
GoTo MyEnding
End If

i = i + 1
String2 = Worksheets("Sheet1").Cells(i, "B").Value

If StrComp(String1, String2, vbTextCompare) <> 0 Then
LastRow = i - 1
A = FirstRow
B = LastRow
Txt = "Core"
Set Status = Range(Cells(FirstRow, 3), Cells(LastRow, 3))
MsgBox "Core Found in Cell " & Value = Status.Address
'Do
'Replacement = ActiveCell.Value
'Replacement = "Core"
'Range("C" & FirstRow & ":C" & LastRow).Select
'Selection.Replace What:=",", Replacement:=Replacement, LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False
'RowNum = RowNum + 1
'Range("B" & RowNum).Select
'Loop Until ActiveCell.Value = ""

End If

Loop

MyEnding:
bNotFound = False
MsgBox "End of Program"
End Sub

 

[WarPigl3t]

Your code confuses me. I'm still new to using Excel functions in conjunction with VB. I am however a good VB programmer in general. Here's something that looks nothing like your code but works.

Sub Macro1()
    a = 2
    Do Until Range("A" & a).Value = ""
        b = 2
        Core = False
        Do Until Range("B" & b).Value = "" Or Core = True
            If Range("B" & b).Value = "Core" And Range("A" & b).Value = Range("A" & a).Value Then
                Core = True
            End If
            b = b + 1
        Loop
        If Core = True Then
            b = 2
            Do Until Range("A" & b).Value = ""
                If Range("A" & b).Value = Range("A" & a).Value Then
                    Range("B" & b).Value = "Core"
                End If
                b = b + 1
            Loop
        End If
    a = a + 1
    Loop
End Sub

This is the dataset I used before I ran the code.

	A	B
1	Software Title	Status
2	1-2-3	Prohibited
3	1-2-3	Prohibited
4	1-2-3	Core
5	1-2-3	New
6	1-2-3	Prohibited
7	1-2-4	Core
8	1-2-7	New
9	1-2-4	New
10	1-2-5	Prohibited
11	1-2-3	New
12	1-2-5	Core

<tbody>
</tbody>

This is the dataset after the code was run.
vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv

	A	B
1	Software Title	Status
2	1-2-3	Core
3	1-2-3	Core
4	1-2-3	Core
5	1-2-3	Core
6	1-2-3	Core
7	1-2-4	Core
8	1-2-7	New
9	1-2-4	Core
10	1-2-5	Core
11	1-2-3	Core
12	1-2-5	Core

<tbody>
</tbody>

As you can see, it changed everything but cell A8 because that value didn't have "Core" in it's corresponding B cell.

 

[Boham2000]

WarPiglet,

Thank you for your quick response. I quickly reviewed and placed your code into a macro and it is a great start. I will take a few days to digest the code and play with it in my larger macro. I will let you know how it comes out.

Thanks again for the help
Bobby

 

[WarPigl3t]

Awesome. Though it shouldn't take you days to understand my code. I don't use complicated excel function features. I use good old fashioned logic. The "Do Until" areas are nothing more that a way to cycle through column A and B. It starts in A2 and checks B2 through the last cell that isn't blank in the B column. It checks to see if A2 through the last cell in the A column that isn't blank and that one of those matching values has "Core" in it. If any cell that matches A2's value says "Core", then B2's value changes to "Core". Then the it cycles to A3 and does it all again. And so on until it gets to the last non blank cell in the A column. It's easy.

 

[Boham2000]

I finally got back to this yesterday and you are correct the logic of your code was very easy for me to follow and I have completed that step of the project. I greatly appreciate your input; your method was a lot less complex than the approach I was taking. Thanks Again!

 

[Boham2000]

OKay, I finished the macro and ran it successfully with only one small issue... There are about 540,000 rows in the sheet and this part of the macro has been running for 15 minutes without completing. Now, I'm looking to see if I can speed it up:

Sub Status_Rationalization()
' Rationalization of Status - Searches through status by unique software titles to rationalize Core, Standard, Approved, Reserved, Legacy, and Pending.
B = 2
Do Until Range("B" & B).Value = ""
C = 2
Core = False
Standard = False
Approved = False
Reserved = False
Legacy = False
Pending = False
Do Until Range("C" & C).Value = "" Or Core = True Or Standard = True Or Approved = True Or Reserved = True Or Legacy = True Or Pending = True
If Range("C" & C).Value = "Core" And Range("B" & C).Value = Range("B" & B).Value Then
Core = True
Else
If Range("C" & C).Value = "Standard" And Range("B" & C).Value = Range("B" & B).Value Then
Standard = True

Else
If Range("C" & C).Value = "Approved" And Range("B" & C).Value = Range("B" & B).Value Then
Approved = True

Else
If Range("C" & C).Value = "Reserved" And Range("B" & C).Value = Range("B" & B).Value Then
Reserved = True

Else
If Range("C" & C).Value = "Legacy" And Range("B" & C).Value = Range("B" & B).Value Then
Legacy = True

Else
If Range("C" & C).Value = "Pending" And Range("B" & C).Value = Range("B" & B).Value Then
Pending = True
End If
End If
End If
End If
End If
End If

C = C + 1
Loop
If Core = True Then
C = 2
Do Until Range("B" & C).Value = ""
If Range("B" & C).Value = Range("B" & B).Value Then
Range("C" & C).Value = "Core"
End If
C = C + 1
Loop
End If

If Standard = True Then
C = 2
Do Until Range("B" & C).Value = ""
If Range("B" & C).Value = Range("B" & B).Value Then
Range("C" & C).Value = "Standard"
End If
C = C + 1
Loop
End If

If Approved = True Then
C = 2
Do Until Range("B" & C).Value = ""
If Range("B" & C).Value = Range("B" & B).Value Then
Range("C" & C).Value = "Approved"
End If
C = C + 1
Loop
End If

If Reserved = True Then
C = 2
Do Until Range("B" & C).Value = ""
If Range("B" & C).Value = Range("B" & B).Value Then
Range("C" & C).Value = "Reserved"
End If
C = C + 1
Loop
End If

If Legacy = True Then
C = 2
Do Until Range("B" & C).Value = ""
If Range("B" & C).Value = Range("B" & B).Value Then
Range("C" & C).Value = "Legacy"
End If
C = C + 1
Loop
End If

If Pending = True Then
C = 2
Do Until Range("B" & C).Value = ""
If Range("B" & C).Value = Range("B" & B).Value Then
Range("C" & C).Value = "Pending"
End If
C = C + 1
Loop
End If
B = B + 1
Loop
End Sub