Cut,clear and replace.

[topi1]

Hi,
I am hoping to get a vba for the following.
In sheet2, column R, loop through cells and look for cells which start with "GHT:" (not case sensitive).
If it finds two cells that begin with "GHT:", cut and clear the bottom one and paste replace the top one.

Not critical but it will be nice if GHT can be all CAP after cell has been pasted, regardless of how the bottom cell originally was.

The number of preceding, intervening and subsequent rows vary.
"GHT:" could be in the first row although unlikely.
No blanks.
Thank you.

Here is the example.

BEFORE

Only necessary VBA 11.xlsm
	R
1	1
2	2
3	3
4	GHT: 1
5	4
6	5
7	6
8	Ght: 2
9	7
Sheet2

AFTER

Only necessary VBA 11.xlsm
	R
1	1
2	2
3	3
4	GHT: 2
5	4
6	5
7	6
8
9	7
Sheet2

 

[awoohaw]

What if there are more than to Ght cells?
Do you only want the last Ght moved to the first?

 

[topi1]

There will be 1 or 2 ght cells. No more than 2.Thanks.

 

[awoohaw]

I'm sure there are more elegant ways. but this seems to work with the constraints you have given:
(it probably will not work if you have that string in cells in adjacent columns, but you can update the vba)

Sub PutLastGhtInFirst()
Dim c As Integer
Dim r As Range
Dim f As Range
Dim s As Range

Set r = ActiveCell.CurrentRegion.Cells

c = 0

For Each cell In r
    If InStr(1, cell, "ght", vbTextCompare) Then c = c + 1
    If c = 1 Then Set f = cell
    If c = 2 Then
        Set s = cell
        f.Value = UCase(s.Value)
        s.Clear
        End If
    Next cell
c = 0 
End Sub

 

[topi1]

I'm sure there are more elegant ways. but this seems to work with the constraints you have given:
(it probably will not work if you have that string in cells in adjacent columns, but you can update the vba)

Sub PutLastGhtInFirst()
Dim c As Integer
Dim r As Range
Dim f As Range
Dim s As Range

Set r = ActiveCell.CurrentRegion.Cells

c = 0

For Each cell In r
    If InStr(1, cell, "ght", vbTextCompare) Then c = c + 1
    If c = 1 Then Set f = cell
    If c = 2 Then
        Set s = cell
        f.Value = UCase(s.Value)
        s.Clear
        End If
    Next cell
c = 0
End Sub

Did not work for me. Changed "ght" to "ght:", that did not help. Made vba and cells cASE specific, that did not help either. Nothing happens when I run the code. TY.

 

[awoohaw]

Sorry, try this:

Sub PutLastGhtInFirst()
Dim c As Integer
Dim ff As Boolean
Dim fs As Boolean
Dim r As Range
Dim f As Range
Dim s As Range

Set r = ActiveCell.CurrentRegion.Cells

c = 0
ff = False
fs = False
For Each cell In r
    If InStr(1, cell, "ght", vbTextCompare) Then c = c + 1
    If c = 1 And ff = False Then
        Set f = cell
        ff = True
        End If
    If c = 2 And fs = False Then
        Set s = cell
        f.Value = UCase(s.Value)
        s.Clear
        fs = True
        End If
    Next cell
   
c = 0
ff = False
fs = False
   
End Sub

 

[topi1]

Sorry, try this:

Sub PutLastGhtInFirst()
Dim c As Integer
Dim ff As Boolean
Dim fs As Boolean
Dim r As Range
Dim f As Range
Dim s As Range

Set r = ActiveCell.CurrentRegion.Cells

c = 0
ff = False
fs = False
For Each cell In r
    If InStr(1, cell, "ght", vbTextCompare) Then c = c + 1
    If c = 1 And ff = False Then
        Set f = cell
        ff = True
        End If
    If c = 2 And fs = False Then
        Set s = cell
        f.Value = UCase(s.Value)
        s.Clear
        fs = True
        End If
    Next cell
  
c = 0
ff = False
fs = False
  
End Sub

I am running the code on the following file. But nothing happens.

Only necessary VBA 11.xlsm
	R
1	1
2	2
3	3
4	GHT: 1
5	4
6	5
7	6
8	GHT: 2
9	7
Sheet2

 

[awoohaw]

it is working for me.
Your cursor must be in the range of cells you want to transform when you run the macro

before:

Book1
	A	B
1	1
2	2
3	3
4	ght: 1
5	4
6	5
7	6
8	Ght: 2
9	7
10
Sheet1

after:

Book1
	A	B
1	1
2	2
3	3
4	GHT: 2
5	4
6	5
7	6
8
9	7
10
Sheet1

Another:

Before:

Book1
	A	B
1	1
2	2
3	3
4	GHT: 1
5	4
6	5
7	6
8	GHT: 2
9	7
10
Sheet1

After:

Book1
	A	B
1	1
2	2
3	3
4	GHT: 2
5	4
6	5
7	6
8
9	7
10
Sheet1

 

[topi1]

it is working for me.
Your cursor must be in the range of cells you want to transform when you run the macro

before:

Book1
	A	B
1	1
2	2
3	3
4	GHT: 1
5	4
6	5
7	6
8	GHT: 2
9	7
10
Sheet1

after:

Book1
	A	B
1	1
2	2
3	3
4	GHT: 2
5	4
6	5
7	6
8
9	7
10
Sheet1

Let me rerun. I move my cursor to go to view>macro etc so I know the cursor is not in the range.

 

[topi1]

@awoohaw I think I have found the issue. Your code works when the data is in the column A but not when it is in the column R. My data is in the column R though. I think the following modified version works. Thank you for all your help.

    Worksheets("Sheet2").Activate
    Set r = Worksheets("Sheet2").Range("R:R")
    
    c = 0
    ff = False
    fs = False
    For Each cell In r.Cells
        If InStr(1, cell.Value, "GHT", vbTextCompare) Then c = c + 1
        If c = 1 And ff = False Then
            Set f = cell
            ff = True
        End If
        If c = 2 And fs = False Then
            Set s = cell
            f.Value = UCase(s.Value)
            s.ClearContents
            fs = True
        End If
    Next cell
    
    c = 0
    ff = False
    fs = False
End Sub