PDA

View Full Version : Restructuring of data without a standardized format



mycelium
06-27-2019, 06:18 PM
Hi all,

The data I got on hand is not presented in a standardized format.

I would like to create a VBA function to restructure the data if the condition matches.


More details can be found in the Attachment uploaded 24517.

Thanks


Ideal way of working:

Step 1: Look into Cell B2 & C2 in Data Sheet
Step 2: Match to see if any of the Invoice No. in Reference Sheet is present in B2 or C2

Step 3a: If present, make the Invoice No. row as reference and further match the company, type, date in Cell B2 / C2
Step 4a: Output the matched data onto Cell D2 in DataSheet
Step 5a: Continue to next row (Cell B3 & C3)

Step 3b: If not present, continue to next row (Cell B3 & C3)

mana
06-28-2019, 04:16 AM
Option Explicit


Sub test()
Dim dic As Object
Dim aryl As Object
Dim k As Long
Dim r As Range
Dim c As Range
Dim s
Dim inv As String
Dim e, e2

Set dic = CreateObject("scripting.dictionary")
Set aryl = CreateObject("system.collections.arraylist")

With Sheets("Reference Sheet").Cells(1).CurrentRegion
For k = 2 To .Rows.Count
inv = .Cells(k, 1).Value
Set dic(inv) = CreateObject("system.collections.arraylist")
dic(inv).Add inv
dic(inv).Add .Cells(k, 2).Value 'company
dic(inv).Add .Cells(k, 3).Value 'type
dic(inv).Add .Cells(k, 4).Value 'date
Next
End With

Set r = Sheets("Data Sheet").Cells(1).CurrentRegion.Columns(2)
Set r = r.Resize(r.Rows.Count - 1).Offset(1)

r.Offset(, 2).ClearContents

For Each c In r.Cells
s = Split(c.Value & " " & c.Offset(, 1).Value)
For Each e In s
If dic.exists(e) Then
aryl.Clear
For Each e2 In s
If IsDate(e2) Then e2 = DateValue(e2)
If dic(e).contains(e2) Then aryl.Add e2
Next
c.Offset(, 2).Value = Join(aryl.toarray)
Exit For
End If
Next
Next

End Sub