Code to convert Bluebeam.CSV to Color-coded rows in excel

Sub ColorRowByColor()
    ''find 'color' column
    LastCol = ActiveSheet.Cells(1, Columns.count).End(xlToLeft).Column
    For XCOL = 1 To LastCol
        If LCase(ActiveSheet.Cells(1, XCOL).Value) Like "*color*" Then
            colorcol = XCOL
            Exit For
        End If
    Next
   
    LastRow = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row
    For irow = 2 To LastRow
        ActiveSheet.Rows(irow).Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = Hex2Dec(ActiveSheet.Cells(irow, colorcol).Value)
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    Next irow
End Sub

Function Hex2Dec(HexVal As String) As Variant
    Hex2Dec = ""
    Dim r As Byte
    Dim g As Byte
    Dim b As Byte
   
    HexVal = Right(HexVal, 6)
   
    ''hexinit = CLng("&H" & HexVal)
    '''resturns half-tone lighter values for backgrounds
   
    r = (CByte("&H" & Mid(HexVal, 1, 2)) + 255) / 2
    If r > 255 Then r = 255
   
    g = (CByte("&H" & Mid(HexVal, 3, 2)) + 255) / 2
    If g > 255 Then r = 255
   
    b = (CByte("&H" & Mid(HexVal, 5, 2)) + 255) / 2
    If b > 255 Then r = 255
   
    On Error Resume Next
    Hex2Dec = CLng("&H" & Hex(r) & Hex(g) & Hex(b))
End Function


Comments

Popular posts from this blog

Revit area plans adding new types and references (Gross and rentable)

Powerpoint countdown and current time in slides VBA

Revit 2019 and up tab colorizer