View Full Version : Solved: Turn bold first of set in a list
IgnBan
03-02-2008, 02:40 PM
Good day everybody!
I have a sheet that shows Units to be repair, with 3 columns; A (Status), B (Unit) and C (discrepancy) this workbook previously posted for filter question.
Is it possible in the list of Units (some will repeat several times) to turn the first of the set bold?
My idea is to visually identify a Unit with several discrepancies.
Note; Please see how the list is generated by Xld code on the WorkSheet_Activate()
I?m including the sample workbook
Thanks guys! Any input is in advance appreciated :thumb
Bob Phillips
03-02-2008, 02:53 PM
Private Sub Worksheet_Activate()
Dim mpLastRow As Long
Dim mpNextRow As Long
Dim mpTargetRow As Long
mpLastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
With Me.Rows("2:" & mpLastRow + 50)
.Borders(xlLeft).LineStyle = xlNone
.Borders(xlRight).LineStyle = xlNone
.Borders(xlTop).LineStyle = xlNone
.Borders(xlBottom).LineStyle = xlNone
.ClearContents
.Font.Bold = False
End With
mpNextRow = 4
With Worksheets("Sheet1")
mpTargetRow = 2
For Each mpRow In .UsedRange.Rows
If mpRow.Cells(1, "B").Value = "Needs Repair" Then
mpRow.Cells(1, "B").Resize(, 3).Copy
Me.Cells(mpNextRow, "A").PasteSpecial Paste:=xlPasteValues
If Me.Cells(mpNextRow, "B").Value <> Me.Cells(mpNextRow - 1, "B").Value Then
Me.Cells(mpNextRow, "A").Resize(, 3).Font.Bold = True
End If
mpNextRow = mpNextRow + 1
End If
Next mpRow
End With
mpLastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
If mpLastRow > 1 Then
With Me.Range("A1").Resize(mpLastRow, 3)
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
.Borders(xlEdgeTop).LineStyle = xlNone
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
End If
Me.Range("A1").Select
End Sub
IgnBan
03-02-2008, 03:19 PM
Xld, thanks for you prompt answer. Xl is it possible to only turn bold the "Unit" column? .... also how can I do the same in Sheet1 "Unit" column?
Thanks again!
Bob Phillips
03-02-2008, 03:45 PM
Private Sub Worksheet_Activate()
Dim mpLastRow As Long
Dim mpNextRow As Long
Dim mpTargetRow As Long
Application.ScreenUpdating = False
mpLastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
With Me.Rows("2:" & mpLastRow + 50)
.Borders(xlLeft).LineStyle = xlNone
.Borders(xlRight).LineStyle = xlNone
.Borders(xlTop).LineStyle = xlNone
.Borders(xlBottom).LineStyle = xlNone
.ClearContents
End With
mpNextRow = 4
With Worksheets("Sheet1")
mpTargetRow = 2
For Each mpRow In .UsedRange.Rows
If mpRow.Row > 1 Then
With mpRow.Cells(1, "C")
.Font.Bold = .Value <> .Offset(-1, 0).Value
End With
If mpRow.Cells(1, "B").Value = "Needs Repair" Then
mpRow.Cells(1, "B").Resize(, 3).Copy
Me.Cells(mpNextRow, "A").PasteSpecial Paste:=xlPasteValues
Me.Cells(mpNextRow, "B").Font.Bold = _
Me.Cells(mpNextRow, "B").Value <> Me.Cells(mpNextRow - 1, "B").Value
mpNextRow = mpNextRow + 1
End If
End If
Next mpRow
End With
mpLastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
If mpLastRow > 1 Then
With Me.Range("A1").Resize(mpLastRow, 3)
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
.Borders(xlEdgeTop).LineStyle = xlNone
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
End If
Application.ScreenUpdating = True
Me.Range("A1").Select
End Sub
IgnBan
03-02-2008, 03:54 PM
Xld, ones again can't thank you enough for you help!
It runs even smother and faster with the Screen Updated code!
Thanks alot!
Bob Phillips
03-02-2008, 04:47 PM
Yeah, the flashing was irritating me.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.