Information compiling

[Gabr1el]

Hello :hi:,

I'm still a beginner in VBA but very eager to improve. That is why I'm looking for assistance with the following.

I have a file with 4 sheets.
In sheet("1"), I'd like the information contained in column C, G and N to be compiled in the sheet("3") :
For every Material description (Sheet1, P1), there are different possible Material code (C1) that can occur several times.
What I woud like is, for a given Material description specified in A1 of Sheet("3"), to get the list of each individual related Material code in column A1, the sum of the total quantity in column B, the sum of the total amounts in column C and finally the unit price in column D.

I originally asked for help for that, but I don't quite fully understand the looping process in the code.
Please file attached where you will find lines of code that in spite of having tried to modify them result in error message.

Thank you in advance.

19329

[GTO]

Greetings and welcome to VBAX Gabriel,

I think I am following most of it, and I see why it is hard to learn with such non-intuitive variable naming. Anyways, I may be missing it, but for the output sheet (3), where are we getting MAP (unit price) from?

Mark

[Gabr1el]

Hello Mark,

Thank you for your answer.
Apologies, I forgot to mention that MAP (unit price) would be calculated by the code.
I'm aware that I could just directly key a simple formlula in the cell (=Amount/Qty) but I thought it would be interesting to see how it would look by coding it.

Gab

[GTO]

Okay, but where does it come from? Should we have couple of columns on another sheet with per-unit-price for each Material code or???

Never mind the above; a thick-headed moment...

[Gabr1el]

We have the total amount as well as Qty for each Material code in Sheet1 (which is split in many different line items).
To actually get the total (amount+Qty) of every single Material code of a Material Description, we need to sum up these line items in Sheet3 and unit price would calculated thanks to coding.

Please, see the attached file as an example. 19333
I tried to get inspiration from this but could not apply to my specific file format (file.xlsm)
Hope this helps.

Thank you.

[GTO]

Here you go Gab. I have re-attached the WB and commented the code to help explain it. Don't hesitate to ask questions if anything is not sensible. I tried following the example code you had, but went a bit different route.

I would mention that I added a reference to scrunn (FSO/Dictionary). I usually use early-binding when writing (intellisense makes it easier to write) and late-binding for release.

Mark



Option Explicit

Public Sub example01()
Dim DIC As Scripting.Dictionary '<--Early-bound (EB) for development, intellisense to make it easier...
Dim rngLastCellFound As Range
Dim rngRecordsData As Range
Dim arrRecordsData As Variant
Dim arrOutput As Variant
Dim arrItems As Variant
Dim ArrayRow As Long
Dim ArrayColumn As Long
Dim strDescript2Look4 As String
Dim tmp(1 To 2) As Double

With shtRecords
'// Find last cell in column C with data //
Set rngLastCellFound = RangeFound(.Range(.Cells(2, "C"), .Cells(.Rows.Count, "C")))
'// If we don't find any 'Material Code(s)', bail out //
If rngLastCellFound Is Nothing Then Exit Sub
'// Set our range from A2 to last row in column R //
Set rngRecordsData = .Range(.Cells(2, "A"), .Cells(rngLastCellFound.Row, "R"))
End With

'// Create an array from our records, set reference to created dictionary, assign the //
'// value we are looking for. //
arrRecordsData = rngRecordsData.Value
Set DIC = CreateObject("Scripting.Dictionary")
DIC.CompareMode = 1& '<-- EB constant 'TextCompare' value
strDescript2Look4 = UCase$(shtOutput.Range("A1").Value)

'// We can use 1 instead of LBound as a range flipped to a variant/array will be 1-based//
For ArrayRow = 1 To UBound(arrRecordsData, 1)
'// If 'material description' matches... //
If UCase$(arrRecordsData(ArrayRow, 16)) = strDescript2Look4 Then
'// We'll use 'material code(s)' as unique keys, so check if the key already exists //
If DIC.Exists(arrRecordsData(ArrayRow, 3)) Then
'// Each key's item is our tmp() array, holding the current values/sums for //
'// 'stock quantity' and 'stock value'. So add the current record's values to //
'// the appropriate element in tmp() held in .Item. Then plunk tmp() back into //
'// the appropriate kety's .Item //
tmp(1) = arrRecordsData(ArrayRow, 7) + DIC.Item(arrRecordsData(ArrayRow, 3))(1)
tmp(2) = arrRecordsData(ArrayRow, 14) + DIC.Item(arrRecordsData(ArrayRow, 3))(2)
DIC.Item(arrRecordsData(ArrayRow, 3)) = tmp
Else
'// Else if the Key doesn't exist, assign values to tmp() and create the key with //
'// tmp() assigned to .Item. //
tmp(1) = arrRecordsData(ArrayRow, 7)
tmp(2) = arrRecordsData(ArrayRow, 14)
DIC.Add arrRecordsData(ArrayRow, 3), tmp
End If
End If
Next

'// Flip .Keys to give us a 2-d array, like arrOutput(1 to 4, 1 to 1) //
arrOutput = Application.Transpose(DIC.Keys)
'// Preserve and resize to 4 columns //
ReDim Preserve arrOutput(1 To UBound(arrOutput, 1), 1 To 4)
'// .Items will return a 0-based 1-d array, 0 To 3 from our example data //
arrItems = DIC.Items

For ArrayRow = 1 To UBound(arrOutput, 1)
'// arrItems() holds our 2-element arrays in each element of arrItems(); hence, the //
'// second set of parenthesis to indicate which element of tmp() we are grabbing. //
arrOutput(ArrayRow, 2) = arrItems(ArrayRow - 1)(1)
arrOutput(ArrayRow, 3) = arrItems(ArrayRow - 1)(2)
arrOutput(ArrayRow, 4) = arrOutput(ArrayRow, 3) / arrOutput(ArrayRow, 2)
Next

shtOutput.Range("A3").Resize(UBound(arrOutput), 4).Value = arrOutput

End Sub

'// Simply a wrapper for .Find method with defaults. //
Public Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange.Cells(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

[Gabr1el]

Thanks a lot Mark!
I will look at the code in more detail and will certainly come back with a couple of question for my understanding.

Gab

[GTO]

You are most welcome.:beerchug:

[Gabr1el]

Hello Mark,

If I try to use the code in a new file (renaming properly the sheets) applying the exact same format as the original file, I end up getting a compile error: User-defined type not defined message. Am I missing something ?


Thanks

[GTO]

Hello Gab,

When the error occurred, did it highlight "DIC As Scripting.Dictionary" at the top of the procedure?

If yes, the cause of the error is that you did not set a reference to the required library: Microsoft Scripting Runtime

Here are some links reference early vs. late-binding:

Using early binding and late binding in Automation (https://support.microsoft.com/en-us/help/245115/using-early-binding-and-late-binding-in-automation)

Early vs. Late Binding (http://peltiertech.com/Excel/EarlyLateBinding.html)

And reference using the Dictionary:

Using the Dictionary Class in VBA (https://www.experts-exchange.com/articles/3391/Using-the-Dictionary-Class-in-VBA.html)

Excel VBA Dictionary – A Complete Guide (https://excelmacromastery.com/vba-dictionary/) ***


*** - I would note that where you see declarations for early-binding like:


Dim dict As New Scripting.Dictionary

...this is referred to as auto-instancing, which you can read about (why NOT to do this) in Introduction To Classes (http://www.cpearson.com/excel/classes.aspx) by Chip Pearson.

Hope that helps,

Mark

[Gabr1el]

Thank you again, that's great help.
Gab

[GTO]

Glad that helped:beerchug:

As I failed to mention, I would normally change early-bound references to late-bound before 'releasing' the project for general user usage. Although I am unaware of any version changes to Scrunn.dll (the dll for Microsoft Scripting Runtime), using late-bound references prevents version dependent issues.



' CHange:
'Dim DIC As Scripting.Dictionary '<--Early-bound (EB) for development, intellisense to make it easier...
'To:
Dim DIC As Object '<--Late-bound for release, but no intellisense for re-writes
'...then de-reference the library