Posts by DarrenSmith1981

Private Sub Jobcard_Demands_Click()


If Jobcard_Demands = ("Drawing No`s Update") Then


Dim matchRange As Range
Dim ODict As Object
Dim PartsListLastRow As Long, DestLastRow As Long
Dim LookupRange As Range
Dim i As Integer
Dim wsSource As Worksheet, wsDest As Worksheet


Set wsSource = ThisWorkbook.Worksheets("Parts List")
Set wsDest = ThisWorkbook.Worksheets("Job Card Master")


PartsListLastRow = wsSource.Range("A" & Rows.Count).End(xlUp).Row
DestLastRow = wsDest.Range("A" & Rows.Count).End(xlUp).Row


'This holds the lookup range (including both the lookup key
'column and the value column)
Set matchRange = wsSource.Range("E1:F" & PartsListLastRow)


'Get a dictionary of all the lookup values. The function, as
'defined below, takes the range as well as the relative column
'of the keys and values. In our case, the first column of our
'range has the keys, and the second has the values
Set ODict = GetDictionary(matchRange, 5, 6)


'Below, define the lookup range. In your specific code, this
'varies based on the combobox value, but I think you'll be able
'to figure out how to define it (I'm just hardcoding mine
Set LookupRange = wsDest.Range("A1:A" & DestLastRow)


'Loop over the lookup range
For i = 1 To DestLastRow
'Since the GetPartInfo function handles cases where there isn't a match
' (it returns a blank string), you don't have to use an if/else statement
wsDest.Range("B" & i).Value = GetPartInfo(ODict, wsDest.Range("E" & i).Value)
Next i
End If
End Sub


Private Function GetDictionary(rng As Range, keyCol As Long, valCol As Long) As Object
Dim sht As Worksheet
Dim rCell As Range
Dim ODict As Object


Set sht = rng.Parent
Set ODict = CreateObject("Scripting.Dictionary")


For Each rCell In rng.Columns(keyCol).Cells
If Not ODict.Exists(rCell.Offset(, keyCol - 1).Value) Then
ODict.Add rCell.Offset(, keyCol - 1).Value, rCell.Offset(, valCol - 1).Value
End If
Next rCell


Set GetDictionary = ODict
End Function


'This is just a helper function to de-clutter the main subroutine. Returns an
' empty string in cases where the part doesn't exist in the dictionary
Private Function GetPartInfo(ByRef ODict As Object, sKey As String)
Dim Output As String


Output = ""


If ODict.Exists(sKey) Then
Output = ODict(sKey)
End If


GetPartInfo = Output
End Function

Private Sub Body_Type_Click()


Select Case Body_Type.Value


Case ("Tippa")
Me.Toolpod_Width.Visible = False




Case ("Dropside")
Me.Toolpod_Width.Visible = False


Case ("Tippa with Toolpod")
Me.Toolpod_Width.Visible = True




Case ("Dropside with Toolpod")
Me.Toolpod_Width.Visible = True




End Select




Body_Type.Value = ("Body Type")


End Sub


Private Sub Add_Break_Lines_Click()


Dim cmb As ComboBox
Dim ws As Worksheet
Dim LastRow As Long
Dim rngToCheck As Range, rng As Range




Set ws = ThisWorkbook.Worksheets("Job Card Master")
Set cmb = Me.Add_Break_Lines
Set rngToCheck = ws.Range("A13:Q299")


For Each rng In rngToCheck
If rng.Interior.ColorIndex = 36 Then
rng.Interior.Pattern = xlNone
End If
Next rng


LastRow = ws.Cells(Rows.Count, 3).End(xlUp).Row


ws.Range("P13:P299").ClearContents


Select Case cmb.Value


Case ("Break Lines 1 Page Job Card")
colorAbove ws.Range("A13:Q" & LastRow)


Case ("Break Lines 2 Page Job Card")
colorAbove ws.Range("A13:Q61")
colorAbove ws.Range("A66:Q" & LastRow)


Case ("Break Lines 3 Page Job Card")
colorAbove ws.Range("A13:Q61")
colorAbove ws.Range("A66:Q122")
colorAbove ws.Range("A127:Q" & LastRow)


Case ("Break Lines 4 Page Job Card")
colorAbove ws.Range("A13:Q61")
colorAbove ws.Range("A66:Q122")
colorAbove ws.Range("A127:Q183")
colorAbove ws.Range("A188:Q" & LastRow)


Case ("Break Lines 5 Page Job Card")
colorAbove ws.Range("A13:Q61")
colorAbove ws.Range("A66:Q122")
colorAbove ws.Range("A127:Q183")
colorAbove ws.Range("A188:Q244")
colorAbove ws.Range("A249:Q" & LastRow)
End Select


End Sub
Sub colorAbove(rng As Range)


Dim brg As Range
Dim rrg As Range
Dim EmptyRowNum As Long
Dim i As Long


For i = 1 To rng.Rows.Count
Set rrg = rng.Rows(i)
If WorksheetFunction.CountA(rrg) = 0 Then
EmptyRowNum = EmptyRowNum + 1
End If
If EmptyRowNum = 2 Then
EmptyRowNum = 0
If brg Is Nothing Then
Set brg = rrg
Else
Set brg = Union(brg, rrg)
End If
End If
Next i


If Not brg Is Nothing Then
brg.Interior.ColorIndex = 36
End If


End Sub