Sub a_1_Combine_Takeoff_Items()
'
' a_1_Combine_Takeoff_Items Macro
'
'
'
Response = MsgBox("Run Combine Takeoff Items Macro? -- If Yes, be sure of your selection", vbYesNo)
If Response = vbNo Then Exit Sub
Set selectRng = Selection
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Color = -13312
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Color = -13312
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Color = -13312
.TintAndShade = 0
.Weight = xlThick
End With
Dim rng As Range
Dim lFirst As Long, lLast As Long
Set rng = Selection
If Not rng Is Nothing Then
lFirst = rng.Row
lLast = rng.Rows.Count + lFirst - 1
Range("z_1a_Sub_Cost").Formula = "=SUMIF('Takeoff'!$G$" & lFirst & ":$G$" & lLast _
& ",""*Subcontractor*"",'Takeoff'!$O$" & lFirst & ":$O$" & lLast & ")"
End If
If Not rng Is Nothing Then
lFirst = rng.Row
lLast = rng.Rows.Count + lFirst - 1
Range("z_1_Incidental_Cost").Formula = "=SUMIF('Takeoff'!$E$" & lFirst & ":$E$" & lLast _
& ",""Incidentals Cost"",'Takeoff'!$F$" & lFirst & ":$F$" & lLast & ")"
End If
If Not rng Is Nothing Then
lFirst = rng.Row
lLast = rng.Rows.Count + lFirst - 1
Range("z_2_Mat._Cost").Formula = "=SUMIF('Takeoff'!$G$" & lFirst & ":$G$" & lLast _
& ",""Mat. Cost"",'Takeoff'!$H$" & lFirst & ":$H$" & lLast & ")"
End If
If Not rng Is Nothing Then
lFirst = rng.Row
lLast = rng.Rows.Count + lFirst - 1
Range("z_3_Tax").Formula = "=SUMIF('Takeoff'!$I$" & lFirst & ":$I$" & lLast _
& ",""Tax"",'Takeoff'!$J$" & lFirst & ":$J$" & lLast & ")"
End If
If Not rng Is Nothing Then
lFirst = rng.Row
lLast = rng.Rows.Count + lFirst - 1
Range("z_4_Labor_Cost").Formula = "=SUMIF('Takeoff'!$K$" & lFirst & ":$K$" & lLast _
& ",""Labor Cost"",'Takeoff'!$L$" & lFirst & ":$L$" & lLast & ")"
End If
If Not rng Is Nothing Then
lFirst = rng.Row
lLast = rng.Rows.Count + lFirst - 1
Range("z_5_Equip_Cost").Formula = "=SUMIF('Takeoff'!$M$" & lFirst & ":$M$" & lLast _
& ",""Equip Cost"",'Takeoff'!$N$" & lFirst & ":$N$" & lLast & ")"
End If
If Not rng Is Nothing Then
lFirst = rng.Row
lLast = rng.Rows.Count + lFirst - 1
Range("z_6_Days").Formula = "=SUMIF('Takeoff'!$M$" & lFirst & ":$M$" & lLast _
& ",""Equip Cost"",'Takeoff'!$O$" & lFirst & ":$O$" & lLast & ")"
End If
If Not rng Is Nothing Then
lFirst = rng.Row
lLast = rng.Rows.Count + lFirst - 1
Range("z_7_Total_Cost").Formula = "=SUMIF('Takeoff'!$J$" & lFirst & ":$J$" & lLast _
& ",""Total Cost"",'Takeoff'!$K$" & lFirst & ":$K$" & lLast & ")"
End If
Dim myRange As Range
Dim CopyRange As Range
Set CopyRange = Range("_0_a_a_Combo_Box_Footer")
On Error Resume Next
Set myRange = Selection.Cells(Selection.Rows.Count, 1).Activate.ActiveCell.Offset(1, -4).Select
If myRange Is Nothing Then
MsgBox "No selection made", vbCritical, "Input required"
Exit Sub
End If
CopyRange.Copy
myRange.Insert Shift:=xlDown
Dim rngFound As Range, rngAll As Range
Dim strFirst As String, lColor As Variant, arrColors As Variant
arrColors = Array(RGB(193, 1, 0), RGB(73, 69, 41), RGB(13, 13, 13), RGB(38, 38, 38), RGB(64, 64, 64), RGB(22, 54, 92), RGB(2, 2, 2), RGB(1, 2, 2), RGB(1, 2, 1), RGB(30, 0, 0), RGB(40, 1, 1), RGB(40, 0, 0), RGB(20, 33, 33))
With Selection
For Each lColor In arrColors
With Application.FindFormat
.Clear
.Font.Color = lColor 'Search for font color
End With
On Error Resume Next
Set rngFound = .Find("", .Cells(.Cells.Count), SearchFormat:=True)
On Error GoTo 0
If Not rngFound Is Nothing Then
strFirst = rngFound.Address
Do
If rngAll Is Nothing Then
Set rngAll = rngFound
Else
Set rngAll = Union(rngAll, rngFound)
End If
Set rngFound = .Find("", rngFound, SearchFormat:=True)
Loop While rngFound.Address <> strFirst
End If
Next lColor
End With
If Not rngAll Is Nothing Then
rngAll.Select
Set rngAll = Nothing
Set rngFound = Nothing
strFirst = vbNullString
Else
MsgBox "No cells found with any font color "
End If
Application.FindFormat.Clear
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
selectRng.Select
Application.Run "'" & ActiveWorkbook.Name & "'" & "!z_Link_Line_Number"
End With
Application.Run "'" & ActiveWorkbook.Name & "'" & "!z_Make_Combo_Footer_Fomulas_Relative"
Response = MsgBox("Combo Box Complete - Be Sure to Modify: Item #, Cost Cost, Bid Item, Unit, Unit Qty and Sub Cost", vbOK)
If Response = vbOK Then Exit Sub
End Sub