'OK here it is
Public Function tabExists(tabName As String) As Boolean
Dim c As Integer
c = 0
While c < Worksheets.Count
If Worksheets.Item(c + 1).Name = tabName Then
tabExists = True
Exit Function
End If
c = c + 1
Wend
tabExists = False
End Function
Private Sub btnpop_Click()
'Sheets.item(0).Remove
If Not tabExists("Materials and Workmanship") Then
Sheets.Add.Name = "Materials and Workmanship"
Else
Worksheets("Materials and Workmanship").Cells.Clear
End If
Dim currentNo As Integer
Dim hasheader As Boolean
Dim cnt As Integer
For lngindex = 1 To ListBox2.ListCount
Dim posindex As Long
Dim newstr As String
posindex = InStr(1, ListBox2.List(lngindex - 1), "-", vbTextCompare)
newstr = Mid(ListBox2.List(lngindex - 1), posindex + 1, 2000)
For Each Item In Worksheets("MatsData").Range("C:C")
If Item.Value <> "" And Item.Row > 1 And Item.Value = newstr Then
For Each item2 In Worksheets("MatsData").Range("D" & Item.Row + 1 & ":D" & Item.Row + 220)
If item2.Value <> "" Or Worksheets("MatsData").Range("E" & item2.Row) <> "" Then
Dim myval
myval = Trim(Worksheets("MatsData").Range("E" & item2.Row).Value)
If Worksheets("MatsData").Range("C" & item2.Row - 1) <> "" Then
Worksheets("Materials and Workmanship").Range("B" & currentNo + 1).Value = Trim(Item.Value)
Worksheets("Materials and Workmanship").Range("A" & currentNo + 1).Value = Trim(Worksheets("MatsData").Cells(item2.Row - 1, Item.Column - 2).Value)
Worksheets("Materials and Workmanship").Range("A" & currentNo + 1).Font.Bold = True
Worksheets("Materials and Workmanship").Range("B" & currentNo + 1).Font.Bold = True
currentNo = currentNo + 1
End If
Worksheets("Materials and Workmanship").Range("A" & currentNo + 1).Font.Bold = Worksheets("MatsData").Cells(Item.Row, Item.Column - 2).Font.Bold
If item2.Value = "" Then
'MsgBox (myval)
Worksheets("Materials and Workmanship").Range("B" & currentNo + 1).Value = Trim(myval)
Worksheets("Materials and Workmanship").Range("B" & currentNo + 1).Font.Bold = True
Else
Worksheets("Materials and Workmanship").Range("B" & currentNo + 1).Value = Trim(item2.Value)
End If
Worksheets("Materials and Workmanship").Range("A" & currentNo + 1).Value = Trim(Worksheets("MatsData").Cells(item2.Row, item2.Column - 2).Value)
cnt = cnt + 1
currentNo = currentNo + 1
Else
'currentNo = currentNo - 1
Exit For
End If
Next
End If
Next
Worksheets("Materials and Workmanship").Activate
currentNo = currentNo + 1
Next lngindex
Worksheets("Materials and Workmanship").Range("A1:B" & currentNo).VerticalAlignment = xlVAlignTop
Worksheets("Materials and Workmanship").Range("A1:B" & currentNo).HorizontalAlignment = xlHAlignLeft
Worksheets("Materials and Workmanship").Range("A1:B" & currentNo).Columns.AutoFit
Worksheets("Materials and Workmanship").Range("B:B").ColumnWidth = 80
Worksheets("Materials and Workmanship").Range("B:B").WrapText = True
'New margin code, try this
With ActiveSheet
.PageSetup.PrintArea = .Range("A1", "B" & currentNo).Address
With .PageSetup
.RightMargin = 10
.LeftMargin = 45
.TopMargin = 50
.BottomMargin = 40
'.CenterHeader = "Page # " & lNum & " of " & lTotal
End With
End With
'CODE BY STEPHEN MOLES
' Puts border for Sheets
Dim ColumnAB As Range
Dim Cell As Range
Set ColumnAB = Range(Range("A1"), Range("B" & currentNo).End(xlUp))
ColumnAB.Borders.LineStyle = xlLineStyleNone
ColumnAB.BorderAround Weight:=xlMedium
Range("A65500").Select
For Each x In ActiveSheet.HPageBreaks
Dim counter As Integer
counter = x.Location.Row - 1
Dim BreakColumn As Range
Set BreakColumn = Range(Range("A" & counter), Range("B" & counter))
BreakColumn.Borders(xlEdgeBottom).Weight = xlMedium
Dim NextBreakColumn As Range
Set BreakColumn = Range(Range("A" & counter + 1), Range("B" & counter + 1))
BreakColumn.Borders(xlEdgeTop).Weight = xlMedium
Next
Range("A1").Select
Unload Me
Worksheets("Materials and Workmanship").Move After:=Worksheets("MW Cover Sheet")
Cells.Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
With Range("A1")
.Value = Date
.NumberFormat = "dd/mm/yyyy"
End With
Range("A1").Select
End With
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
UpdateContract
Unload Me
End Sub
Private Sub cmdfsh_Click()
Unload Me
End Sub
Private Sub cmddone_Click()
UpdateContract
Unload Me
End Sub
Private Sub cmdmats_Click()
Unload Me
End Sub
Private Sub CommandButton1_Click()
Me.Hide
End Sub
'CODE ADDED BY MARK
Private Sub cmdAdd_Click()
If ListBox1.ListIndex <> -1 Then
ListBox2.AddItem (ListBox1.Text)
ListBox1.RemoveItem (ListBox1.ListIndex)
End If
Dim oListBox As MSForms.ListBox
Set oListBox = ListBox2
Call SortListBox(ListBox2, 0, 1, 1)
End Sub
Private Sub cmdRemove_Click()
If ListBox2.ListIndex <> -1 Then
ListBox1.AddItem (ListBox2.Text)
ListBox2.RemoveItem (ListBox2.ListIndex)
End If
Dim oListBox As MSForms.ListBox
Set oListBox = ListBox1
Call SortListBox(ListBox1, 0, 1, 1)
End Sub
Private Sub CommandButton2_Click()
With Range("A1")
.Value = Date
.NumberFormat = "dd/mm/yyyy"
End With
End Sub
Private Sub UserForm_Initialize()
PopCatCmbo
End Sub
Public Sub PopCatCmbo()
Dim r2 As Integer
ListBox1.Clear
intCatNum = 0
For r2 = 1 To 399 Step 1
If Not Worksheets("MatsData").Range("C" & r2).Value = "" Then
If r2 > 1 Then 'ignore headers
ListBox1.AddItem (Worksheets("MatsData").Range("A" & r2).Value & "-" & Worksheets("MatsData").Range("C" & r2).Value)
End If
End If
Next
End Sub
Sub SortListBox(oLb As MSForms.ListBox, sCol As Integer, sType As Integer, sDir As Integer)
Dim vaItems As Variant
Dim i As Long, j As Long
Dim c As Integer
Dim vTemp As Variant
'Put the items in a variant array
vaItems = oLb.List
'Sort the Array Alphabetically(1)
If sType = 1 Then
For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
For j = i + 1 To UBound(vaItems, 1)
'Sort Ascending (1)
If sDir = 1 Then
If vaItems(i, sCol) > vaItems(j, sCol) Then
For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
vTemp = vaItems(i, c)
vaItems(i, c) = vaItems(j, c)
vaItems(j, c) = vTemp
Next c
End If
'Sort Descending (2)
ElseIf sDir = 2 Then
If vaItems(i, sCol) < vaItems(j, sCol) Then
For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
vTemp = vaItems(i, c)
vaItems(i, c) = vaItems(j, c)
vaItems(j, c) = vTemp
Next c
End If
End If
Next j
Next i
'Sort the Array Numerically(2)
'(Substitute CInt with another conversion type (CLng, CDec, etc.) depending on type of numbers in the column)
ElseIf sType = 2 Then
For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
For j = i + 1 To UBound(vaItems, 1)
'Sort Ascending (1)
If sDir = 1 Then
If CInt(vaItems(i, sCol)) > CInt(vaItems(j, sCol)) Then
For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
vTemp = vaItems(i, c)
vaItems(i, c) = vaItems(j, c)
vaItems(j, c) = vTemp
Next c
End If
'Sort Descending (2)
ElseIf sDir = 2 Then
If CInt(vaItems(i, sCol)) < CInt(vaItems(j, sCol)) Then
For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
vTemp = vaItems(i, c)
vaItems(i, c) = vaItems(j, c)
vaItems(j, c) = vTemp
Next c
End If
End If
Next j
Next i
End If
'Set the list to the array
oLb.List = vaItems
End Sub