PDA

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.