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

Powerpoint countdown and current time in slides VBA

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