Bold Selected Text

[Perodin]

I have 23 headings that I need to bold (and hopefully move left 1 column) that are currently the same format as the data cells they are among. I can find them manually, but these 23 headings occurs in each of 40 sheets of data, and I would like to not play hide and seek that many times. Is there a way to enter a cell value or set of values such as "Bearings & Bushings" and accomplish this. Even if i have to run the module for each sheet this would be of help.

I need the first to become the second

Bearings & Bushings

4607 Ball bearings (5x11x4mm) (8) ..................................................... $24.00

2728 Ball bearings (5x8x2.5mm) (2) ..................................................... $8.00

5116 Ball bearings, blue rubber sealed (5x11x4mm) (2) ......................... $3.50

5114 Ball bearings, blue rubber sealed (5x8x2.5mm) (2) ................... $4.00

2545 Bellcrank bushings (plastic) (5x8x2.5mm) (4) ................................. $3.00

1675 Bushings, self-lubricating (5x11x4mm) (14) ............................... $5.00

1985 PTFE-coated washers, 5x8x0.5mm (20) (use with ball bearings) ... $2.00

Body & accessories

1926 Antenna caps, vinyl (2)/ antenna spool ...................................... $2.00

1726 Antenna, tube (1)/ vinyl antenna cap (1)/ wire retainer (1) .............. $1.00

3935 Body clip (mounting clip), angled, 90-degrees (10) ........................ $3.00

3934 Body clips, heavy duty (12) ............................................................ $3.00

1914R Body mount, front & rear (black)/ body posts, 52mm (2),

38mm (2), 25mm (2), 6.5mm (2)/ body post extensions (2)/

<colgroup><col width="64" style="width:48pt"> </colgroup><tbody>
</tbody>

Bearings & Bushings
	4607 Ball bearings (5x11x4mm) (8) ..................................................... $24.00
	2728 Ball bearings (5x8x2.5mm) (2) ..................................................... $8.00
	5116 Ball bearings, blue rubber sealed (5x11x4mm) (2) ......................... $3.50
	5114 Ball bearings, blue rubber sealed (5x8x2.5mm) (2) ................... $4.00
	2545 Bellcrank bushings (plastic) (5x8x2.5mm) (4) ................................. $3.00
	1675 Bushings, self-lubricating (5x11x4mm) (14) ............................... $5.00
	1985 PTFE-coated washers, 5x8x0.5mm (20) (use with ball bearings) ... $2.00
Body & accessories
	1926 Antenna caps, vinyl (2)/ antenna spool ...................................... $2.00
	1726 Antenna, tube (1)/ vinyl antenna cap (1)/ wire retainer (1) .............. $1.00
	3935 Body clip (mounting clip), angled, 90-degrees (10) ........................ $3.00
	3934 Body clips, heavy duty (12) ............................................................ $3.00
	1914R Body mount, front & rear (black)/ body posts, 52mm (2),
	38mm (2), 25mm (2), 6.5mm (2)/ body post extensions (2)/

<colgroup><col span="2"></colgroup><tbody>
</tbody>

 

[NeonRedSharpie]

Sub MOVETHOSEFREAKINGHEADERSYEAAAAAAAA()

    Dim searchString As String
    
    searchString = InputBox("What header are we looking for?")
    
    For x = 1 To Worksheets.Count
    
        For Each cell In Sheets(x).UsedRange
        Debug.Print cell.Value
        Debug.Print InStr(1, cell.Value, searchString, vbTextCompare)
            If InStr(1, cell.Value, searchString, vbTextCompare) > 0 Then
                With cell
                    .Offset(0, -1) = .Value
                    .Offset(0, -1).Font.Bold = True
                    .Clear
                End With
            End If
        
        Next cell
    
    Next x
    
End Sub

 

[Rick Rothstein]

I have 23 headings that I need to bold (and hopefully move left 1 column)

Assuming two things... first, the column to the left of your data is empty (so that the headings can be put in it) and , second, your headings are the only cells with values in the column not to start with a number (as your poste data shows). If these assumption are correct, then this macro should process all the headings on all the sheets throughout your workbook automatically, but first you must tell the code what column your data is in (change the red E to the column letter for your start of data)...

Sub BoldAndMoveHeadings()
  Dim LastRow As Long, DataColumn As String, WS As Worksheet
  DataColumn = "[COLOR=#ff0000][B]E[/B][/COLOR]"
  LastRow = Cells(Rows.Count, DataColumn).End(xlUp).Row
  For Each WS In Worksheets
    With WS.Cells(1, DataColumn).Offset(, -1).Resize(LastRow)
      .Value = Evaluate(Replace(Replace("IF(ISNUMBER(-LEFT(@1:@#)),"""",@1:@#)", "@", DataColumn), "#", LastRow))
      .Font.Bold = True
      .SpecialCells(xlConstants).Offset(, 1).Clear
    End With
  Next
End Sub

 

[Perodin]

Assuming two things... first, the column to the left of your data is empty (so that the headings can be put in it) and , second, your headings are the only cells with values in the column not to start with a number (as your poste data shows). If these assumption are correct, then this macro should process all the headings on all the sheets throughout your workbook automatically, but first you must tell the code what column your data is in (change the red E to the column letter for your start of data)...

Sub BoldAndMoveHeadings()
  Dim LastRow As Long, DataColumn As String, WS As Worksheet
  DataColumn = "[COLOR=#ff0000][B]E[/B][/COLOR]"
  LastRow = Cells(Rows.Count, DataColumn).End(xlUp).Row
  For Each WS In Worksheets
    With WS.Cells(1, DataColumn).Offset(, -1).Resize(LastRow)
      .Value = Evaluate(Replace(Replace("IF(ISNUMBER(-LEFT(@1:@#)),"""",@1:@#)", "@", DataColumn), "#", LastRow))
      .Font.Bold = True
      .SpecialCells(xlConstants).Offset(, 1).Clear
    End With
  Next
End Sub

Your first assumption was correct, but the column does contain other headings that were pulled with this action. This still largely helps, and coupled with an action that would delete all rows in column A containing a "." it should complete the job. Thank you for the help thus far.

 

[Perodin]

Additionally, could this code be modified to pull any row not starting with 4 numbers to the right? The only cells I want to stay in that column have one of the following formats (####, #####, ####? - such as 3456, 23456, and 6123a) This solve another problem I am having.

 

[Perodin]

Assuming two things... first, the column to the left of your data is empty (so that the headings can be put in it) and , second, your headings are the only cells with values in the column not to start with a number (as your poste data shows). If these assumption are correct, then this macro should process all the headings on all the sheets throughout your workbook automatically, but first you must tell the code what column your data is in (change the red E to the column letter for your start of data)...

Sub BoldAndMoveHeadings()
  Dim LastRow As Long, DataColumn As String, WS As Worksheet
  DataColumn = "[COLOR=#ff0000][B]E[/B][/COLOR]"
  LastRow = Cells(Rows.Count, DataColumn).End(xlUp).Row
  For Each WS In Worksheets
    With WS.Cells(1, DataColumn).Offset(, -1).Resize(LastRow)
      .Value = Evaluate(Replace(Replace("IF(ISNUMBER(-LEFT(@1:@#)),"""",@1:@#)", "@", DataColumn), "#", LastRow))
      .Font.Bold = True
      .SpecialCells(xlConstants).Offset(, 1).Clear
    End With
  Next
End Sub

It also seems that on sheets other than the active one all values shifted left are replaced with bold 0's