Linking the Function to the Dict key

[Darren Smith]

The Function is called ReadData it`s a Dictionary

Private Sub Reset_Drawing_Numbers_Click()
Dim matchRange As Range
Dim oDict As Object
Dim cmb As ComboBox
Dim SourceLastRow As Long, DestLastRow As Long
Dim wsSource As Worksheet, wsDest As Worksheet

Set wsSource = ThisWorkbook.Worksheets("Drawing No")
Set wsDest = ThisWorkbook.Worksheets("Job Card Master")
Set cmb = Me.Reset_Drawing_Numbers
SourceLastRow = wsSource.Range("A" & Rows.Count).End(xlUp).Row
DestLastRow = wsDest.Range("A" & Rows.Count).End(xlUp).Row
Set matchRange = wsSource.Range("C1:L" & SourceLastRow)
Call ReadData
Set oDict = ReadData


Select Case cmb.Value
Dim DataRange As Range
Case ("Reset Drawing No. 1 Page")
Set DataRange = wsDest.Range("A13:Q" & DestLastRow)
Case ("Reset Drawing No. 2 Page")
Set DataRange = wsDest.Range("A13:Q61,A66:Q" & DestLastRow)
Case ("Reset Drawing No. 3 Page")
Set DataRange = wsDest.Range("A13:Q61,A66:Q122,A127:Q" & DestLastRow)
Case ("Reset Drawing No. 4 Page")
Set DataRange = wsDest.Range("A13:Q61,A66:Q122,A127:Q183,A188:Q" & DestLastRow)
Case ("Reset Drawing No. 5 Page")
Set DataRange = wsDest.Range("A13:Q61,A66:Q122,A127:Q183,A188:Q244,A249:Q" & DestLastRow)
End Select

If Not DataRange Is Nothing Then
Dim area As Range
For Each area In DataRange.Areas
 GetPartInfoForRange area.Columns(5), area.Columns(2), oDict
Next area
Reset_Drawing_Numbers.Value = "Reset Drawing Numbers"
End If
End Sub
Sub GetPartInfoForRange(lookupRange As Range, outputRange As Range, DataSet As Object)
 Dim cell As Range
 Dim counter As Long
 Dim oDict As Object
 
 For Each cell In lookupRange.Cells
 counter = counter + 1
 outputRange.Cells(counter) = GetPartInfo(DataSet, cell.Value)
 Next cell

End Sub
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 Function GetDictionary(rng As Range, keyCol As Long, valCol As Long) As Object
Dim rCell As Range
Dim oDict As Object
Dim keyCells As Range

Set keyCells = rng.Columns(keyCol).Cells
Dim valueCells As Range

Set valueCells = rng.Columns(valCol).Cells
Set oDict = CreateObject("Scripting.Dictionary")
For Each rCell In keyCells
 Dim counter As Long
 counter = counter + 1
 If Not oDict.Exists(rCell.Value) Then
 oDict.Add rCell.Value, valueCells.Cells(counter).Value
 
 End If
 
Next rCell
Set GetDictionary = oDict
End Function

 

[Darren Smith]

Here is the Dictionary below

Function ReadData() As Dictionary

     Dim wsSource As Worksheet, wsDest As Worksheet
     Dim DrDict As Scripting.Dictionary
     Dim LastRow As Range, rng As Range
     Dim TPodWidth As ComboBox
     Dim TPod As ToggleButton
     Dim PartsName As String
     Dim i As Integer, x As Integer
     Dim DrawingNo1 As Long, DrawingNo2 As Long, DrawingNo3 As Long, DrawingNo4 As Long, DrawingNo5 As Long, DrawingNo6 As Long, DrawingNo7 As Long, DrawingNo8 As Long, DrawingNo9 As Long
     
        Set wsSource = ThisWorkbook.Worksheets("Drawing No")
        Set wsDest = ThisWorkbook.Worksheets("Job Card Master")
        Set DrDict = New Scripting.Dictionary
        Set TPodWidth = Body_And_Vehicle_Type_Form.Toolpod_Width
        Set TPod = Body_And_Vehicle_Type_Form.Add_Toolpod
        Set rng = wsSource.Range("A2").CurrentRegion

For i = 6 To rng.Rows.Count

            PartsName = rng.Cells(i, "C").Value
            DrawingNo1 = rng.Cells(i, "D").Value
            DrawingNo2 = rng.Cells(i, "E").Value
            DrawingNo3 = rng.Cells(i, "F").Value
            DrawingNo4 = rng.Cells(i, "G").Value
            DrawingNo5 = rng.Cells(i, "H").Value
            DrawingNo6 = rng.Cells(i, "J").Value
            DrawingNo7 = rng.Cells(i, "K").Value
            DrawingNo8 = rng.Cells(i, "L").Value
            DrawingNo9 = rng.Cells(i, "M").Value

If Not DrDict.Exists(PartsName) Then
DrDict.Add Key:=PartsName, Item:=Array(DrawingNo1, DrawingNo2, DrawingNo3, DrawingNo4, DrawingNo5, DrawingNo6, DrawingNo7, DrawingNo8, DrawingNo9)
End If

Next i

 

            For x = 0 To UBound(DrDict.Item(PartsName))
            wsDest.Cells(5, x & LastRow).Value = DrDict.Item(PartsName)(x)



        If wsDest.Range("B2") = "Transit" And wsDest.Range("D6") = "L2 Single" Then
        PartsName = DrawingNo1
        End If
        If wsDest.Range("B2") = "Transit" And wsDest.Range("D6") = "L3 Double" Then
        PartsName = DrawingNo2
        End If
        If wsDest.Range("B2") = "Transit" And wsDest.Range("D6") = "L2 Single" And TPodWidth = 600 And TPod.Value = True Then
        PartsName = DrawingNo3
        End If
        If wsDest.Range("B2") = "Transit" And wsDest.Range("D6") = "L3 Single" And TPodWidth = 600 And TPod.Value = True Then
        PartsName = DrawingNo4
        End If
        If wsDest.Range("B2") = "Transit" And wsDest.Range("D6") = "L3 Double" And TPodWidth = 600 And TPod.Value = True Then
        PartsName = DrawingNo5
        End If
        If wsDest.Range("B2") = "Transit" And wsDest.Range("D6") = "L2 Single" And TPodWidth = 800 And TPod.Value = True Then
        PartsName = DrawingNo6
        End If
        If wsDest.Range("B2") = "Transit" And wsDest.Range("D6") = "L3 Double" And TPodWidth = 800 And TPod.Value = True Then
        PartsName = DrawingNo7
        End If
        If wsDest.Range("B2") = "Transit" And wsDest.Range("D6") = "L2 Single" And TPodWidth = 1000 And TPod.Value = True Then
        PartsName = DrawingNo8
        End If
        If wsDest.Range("B2") = "Transit" And wsDest.Range("D6") = "L3 Double" And TPodWidth = 1000 And TPod.Value = True Then
        PartsName = DrawingNo9
        End If

         Next x

Set ReadData = (PartsName)

End Function

 

[Darren Smith]

Morning All
Please can Someone help today