Macro to Change Header in Row 1

Michael151

Board Regular
Joined
Sep 20, 2010
Messages
247
<!--[if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> </w:Compatibility> <w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel> </w:WordDocument> </xml><![endif]--><!--[if gte mso 10]> <style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0in 5.4pt 0in 5.4pt; mso-para-margin:0in; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman";} </style> <![endif]--> Hello all,

Trying to write a macro that will replace the header in row 1 based on the contents of that column.

In the row 1 header, there is a column marked “System”. I’d like to change this header to the first four letters of the first cell in this column that isn’t blank or contains the word “OPEN.”

For example:

Before:

SYSTEM
OPEN
OPEN
RTSG


After:

RTSG
OPEN
OPEN
RTSG

Another example with a blank cell in row 2:

Before:

SYSTEM

OPEN
RTSF

After:

RTSF

OPEN
RTSF


Any help is most appreciate - thank you!
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
This would be something like:

Find: "System" in Rows(1:1)

Within Found Column:

Find First Cell <> "OPEN" or <> * (blank cell)

With Found Cell, take First 4 Characters

Move to header and replace "System" in Rows(1:1)
 
Upvote 0
Try something like this

ThisWorkBook
Code:
Option Explicit
Option Compare Text
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Select Case Target.Column
        Case 1
            if Target.row <> 1 then exit sub
            i = 2
            Do Until Not IsEmpty(ActiveSheet.Cells(i, Target.Column).Value) And Trim(ActiveSheet.Cells(i, TargetColumn).Value) <> "Open"
                i = i + 1
                If i > 65000 Then MsgBox "Hmmmmm": Exit Sub
            Loop
            ActiveSheet.Cells(1, TargetColumn.Value) = ActiveSheet.Cells(i, TargetColumn).Value
            Exit Sub
        Case 2
            MsgBox "Do what you like"
    End Select
End Sub
 
Last edited:
Upvote 0
Code:
Sub changeheader()
Dim coln As Integer, e, nd
coln = Application.Match("system", Cells.Resize(1), 0)
If Not IsError(coln) Then
    nd = Cells(Rows.Count, coln).End(3).Row
    For Each e In Cells(2, coln).Resize(nd)
        If (e <> "") And (e <> "OPEN") Then Cells(1, coln) = e: Exit For
    Next
End If
End Sub
Match case???
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,037
Members
448,543
Latest member
MartinLarkin

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