Condition added to Sort Code

[Todd Huttenstine]

Below is a code that sorts the data in Range("A4:Z100") by the value in
Combobox1. The value in the Combobox1 will match a value in
Range("A4:Z100"). This is how the data will be sorted.

The code works perfectly, however there is 1 minor change I would like
made(added). One of the rows of data within Range("A4:Z100") has values
that are bold in Column A. I would like for that entire row with the bold
value in Column A to be moved to the very bottom of the data regardless of
its rank when the sort code runs. For instance, lets say the data in
Range("A4:Z100") ends at row 20. But the row with the bold value in Column
A is located in Row 5. I would need Row 5 to be shifted down to the 20th
Row and all the other data to shift up to take Row 5's place.

Dim rng As Range, rng1 As Range
Dim res As Variant
Dim rng2 As Range

Worksheets(4).Range("G2").Value = ComboBox1.Value

With Worksheets(1)
Set rng = .Range("A4:Z100")
Set rng1 = .Range("A4:Z4")
End With
res = Application.Match(ComboBox1.Value, rng1, 0)
If Not IsError(res) Then
Set rng2 = rng1(1, res)
rng.Sort Key1:=rng2, Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End If
Unload Me


Thank you

Todd Huttenstine

 

[David Coleman]

Hi Todd

Obviously something big that you're working on....

Sub macro1()
Dim lastrow, boldrow As Integer
lastrow = 1
boldrow = 0

While (Range("A" & lastrow).Value <> "")
If (Range("A" & lastrow).Font.Bold = True) Then boldrow = lastrow
lastrow = lastrow + 1
Wend
If (boldrow = 0) Then MsgBox ("No bold row found"): Exit Sub

Range(boldrow & ":" & boldrow).Select
Selection.Cut
Rows(lastrow & ":" & lastrow).Select
Selection.Insert shift = xlDown
End Sub


does what you need - if there are two (or more) bold rows it only handles
the last one and it pops a message on screen if no bold row is found....

Regards


David