Find Column Header "location" and then Insert a Column with Column Header "Radius"

[mermaidGurl]

Hi all,

I'm just learning VBA, so I'm struggling with finding the column header "location" and then inserting a column to the right with a column header "radius." I would like to make this so that it loops through all of the worksheets in the workbook.

1-- Function loops through all worksheets in Workbook
2--- find column header
3-- create new column to the right
4-- Name said column
5-- Msg box that shows whether successful not successful



Any help would be greatly appreciated!

 

[wideboydixon]

Public Sub InsertRadiusColumn()

Dim thisWorksheet As Worksheet
Dim locationColumn As Variant
Dim addedCount As Long

addedCount = 0

For Each thisWorksheet In Worksheets
    locationColumn = Application.Match("location", thisWorksheet.Rows(1), 0)
    If Not IsError(locationColumn) Then
        If thisWorksheet.Cells(1, locationColumn + 1).Value <> "radius" Then
            thisWorksheet.Columns(locationColumn + 1).Insert xlShiftToRight
            thisWorksheet.Cells(1, locationColumn + 1).Value = "radius"
            addedCount = addedCount + 1
        End If
    End If
Next thisWorksheet

If addedCount > 0 Then
    MsgBox "# worksheets with added ""radius"" column: " & CStr(addedCount), vbInformation + vbOKOnly, "Insert Radius Column"
End If

End Sub

WBD

 

[Fluff]

Hi & welcome to the board
Assuming your headers are in row 1 try

Sub Addcol()
'mermaidGurl 12/9

    Dim Ws As Worksheet
    Dim NewC As Range
    
        For Each Ws In Worksheets
            Set NewC = Ws.Rows([COLOR=#ff0000]1[/COLOR]).Find(What:="Location", After:=Range("[COLOR=#ff0000]A1[/COLOR]"), LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
            If Not NewC Is Nothing Then
                NewC.Offset(, 1).EntireColumn.Insert
                NewC.Offset(, 1).Value = "Radius"
            End If
            Set NewC = Nothing
        Next Ws
    MsgBox "Done"
End Sub

If not row 1 change the 2 bits in red to suit

 

[mermaidGurl]

Thank you so much WBD! Works perfectly!

 

[mermaidGurl]

Thank you Fluff, appreciate the help

 

[Fluff]

Glad we could help & thanks for the feedback