Bold Selected Text

P

Perodin

Board Regular
Joined
Sep 16, 2014
Messages
54
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
[TABLE="width: 64"]
<colgroup><col width="64" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]Bearings & Bushings[/TD]
[/TR]
[TR]
[TD]4607 Ball bearings (5x11x4mm) (8) ..................................................... $24.00[/TD]
[/TR]
[TR]
[TD]2728 Ball bearings (5x8x2.5mm) (2) ..................................................... $8.00[/TD]
[/TR]
[TR]
[TD]5116 Ball bearings, blue rubber sealed (5x11x4mm) (2) ......................... $3.50[/TD]
[/TR]
[TR]
[TD]5114 Ball bearings, blue rubber sealed (5x8x2.5mm) (2) ................... $4.00[/TD]
[/TR]
[TR]
[TD]2545 Bellcrank bushings (plastic) (5x8x2.5mm) (4) ................................. $3.00[/TD]
[/TR]
[TR]
[TD]1675 Bushings, self-lubricating (5x11x4mm) (14) ............................... $5.00[/TD]
[/TR]
[TR]
[TD]1985 PTFE-coated washers, 5x8x0.5mm (20) (use with ball bearings) ... $2.00[/TD]
[/TR]
[TR]
[TD]Body & accessories[/TD]
[/TR]
[TR]
[TD]1926 Antenna caps, vinyl (2)/ antenna spool ...................................... $2.00[/TD]
[/TR]
[TR]
[TD]1726 Antenna, tube (1)/ vinyl antenna cap (1)/ wire retainer (1) .............. $1.00[/TD]
[/TR]
[TR]
[TD]3935 Body clip (mounting clip), angled, 90-degrees (10) ........................ $3.00[/TD]
[/TR]
[TR]
[TD]3934 Body clips, heavy duty (12) ............................................................ $3.00[/TD]
[/TR]
[TR]
[TD]1914R Body mount, front & rear (black)/ body posts, 52mm (2),[/TD]
[/TR]
[TR]
[TD]38mm (2), 25mm (2), 6.5mm (2)/ body post extensions (2)/[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 128"]
<colgroup><col span="2"></colgroup><tbody>[TR]
[TD="colspan: 2"]

Bearings & Bushings[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]4607 Ball bearings (5x11x4mm) (8) ..................................................... $24.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2728 Ball bearings (5x8x2.5mm) (2) ..................................................... $8.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]5116 Ball bearings, blue rubber sealed (5x11x4mm) (2) ......................... $3.50[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]5114 Ball bearings, blue rubber sealed (5x8x2.5mm) (2) ................... $4.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2545 Bellcrank bushings (plastic) (5x8x2.5mm) (4) ................................. $3.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1675 Bushings, self-lubricating (5x11x4mm) (14) ............................... $5.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1985 PTFE-coated washers, 5x8x0.5mm (20) (use with ball bearings) ... $2.00[/TD]
[/TR]
[TR]
[TD="colspan: 2"]Body & accessories[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1926 Antenna caps, vinyl (2)/ antenna spool ...................................... $2.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1726 Antenna, tube (1)/ vinyl antenna cap (1)/ wire retainer (1) .............. $1.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]3935 Body clip (mounting clip), angled, 90-degrees (10) ........................ $3.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]3934 Body clips, heavy duty (12) ............................................................ $3.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1914R Body mount, front & rear (black)/ body posts, 52mm (2),[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]38mm (2), 25mm (2), 6.5mm (2)/ body post extensions (2)/[/TD]
[/TR]
</tbody>[/TABLE]
 
Sort by date Sort by votes
Code: 
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
 
Upvote 0
Perodin said:
I have 23 headings that I need to bold (and hopefully move left 1 column)
Click to expand...
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)...
Code: 
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
 
Upvote 0
Rick Rothstein said:
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)...
Code: 
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
Click to expand...

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.
 
Upvote 0
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.
 
Upvote 0
Rick Rothstein said:
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)...
Code: 
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
Click to expand...

It also seems that on sheets other than the active one all values shifted left are replaced with bold 0's
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Sort Cells Containing Numbers
Replies
4
Views
830
pgc01
P
P
  • Question Question
Merge data in cells vertically if the last cell in the merge always ends in a price?
Replies
4
Views
621
shuklaankur281190
S
X
  • Question Question
extracting expesific data from prodoct list
Replies
3
Views
1K
Akashwani
Akashwani

Share this page

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