Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies. Only from Platform Scholar.
Course Of The Month
6 days, 11 hours left to enrollBecome a Premium Member and unlock a new, free course in leading technologies each month.
Solved
Order table with macro
Posted on 2016-08-22
Greetings to all;
First of all many thanks for the time to read my question, I've been reviewed in the forum but I have not had capable to find something similar, I have the following table:
and I need to obtain this result
I've used Vlookup in VBA but this function only gives me the 1st result founded.
The reason I need to do this with macros is because this re-arrangement will be part of a loop process with information from different sources, but requiring the same treatment.
I'll be very grateful for any idea / comment or suggestion.
Best regards
Table.xlsx
First of all many thanks for the time to read my question, I've been reviewed in the forum but I have not had capable to find something similar, I have the following table:
and I need to obtain this result
I've used Vlookup in VBA but this function only gives me the 1st result founded.
The reason I need to do this with macros is because this re-arrangement will be part of a loop process with information from different sources, but requiring the same treatment.
I'll be very grateful for any idea / comment or suggestion.
Best regards
Table.xlsx
[X]
Welcome to Experts Exchange
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
- Help others & share knowledge
- Earn cash & points
- Learn & ask questions
2
3 Comments
Active today
Please try this.....
In the attached, click the button Transform Data to get the desired output in a separate sheet.
if you have an issue in downloading and opening the attached file due to a temporary bug in the forum, first download and save it on your system and then open it.
In the attached, click the button Transform Data to get the desired output in a separate sheet.
if you have an issue in downloading and opening the attached file due to a temporary bug in the forum, first download and save it on your system and then open it.
Sub TransformData()
Dim sws As Worksheet, dws As Worksheet
Dim dict As Object
Dim x, y
Dim i As Long, c As Long
Application.ScreenUpdating = False
Set sws = Sheets("Sheet1")
On Error Resume Next
Set dws = Sheets("Final Table")
dws.Cells.Clear
On Error GoTo 0
If dws Is Nothing Then
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Final Table"
Set dws = ActiveSheet
End If
dws.Range("A1:B1").Value = Array("Còdigo", "Lote1")
Set dict = CreateObject("Scripting.Dictionary")
x = sws.Range("A1").CurrentRegion.Value
For i = 2 To UBound(x, 1)
If Not dict.exists(x(i, 1)) Then
dict.Item(x(i, 1)) = x(i, 2)
Else
dict.Item(x(i, 1)) = dict.Item(x(i, 1)) & ";" & x(i, 2)
End If
Next i
dws.Range("A2").Resize(dict.Count).Value = Application.Transpose(dict.keys)
For Each it In dict.keys
y = Split(dict.Item(it), ";")
dws.Range("B" & Rows.Count).End(3)(2).Resize(1, UBound(y) + 1).Value = y
Next it
c = dws.Range("A1").CurrentRegion.Columns.Count
dws.Range("B1").AutoFill dws.Range(dws.Cells(1, 2), dws.Cells(1, c)), xlFillDefault
dws.Range("A1").CurrentRegion.CurrentRegion.Borders.Color = vbBlack
dws.Activate
Application.ScreenUpdating = True
End Sub
Wow!!!!, works like a charm!!!, I'v realized there are a lot of things I need to learn, I've never used a dictionary but the solution is great.
I was wondering if is possible (my apologies for any inconvenience this may cause) you can help me adding some comments to the dictionary part in the macro, those will be very helpful for me to understand how it works.
Once again many thanks for your help.
Best regards
I was wondering if is possible (my apologies for any inconvenience this may cause) you can help me adding some comments to the dictionary part in the macro, those will be very helpful for me to understand how it works.
Once again many thanks for your help.
Best regards
Active today
You're welcome Leonel! Glad to help and thanks for the feedback.
Adding comments for the dictionary part won't help you much unless you read about it. It's just a pretty simple IF block checking if a dictionary key exist or doesn't exist and performs different actions for both the conditions.
Adding comments for the dictionary part won't help you much unless you read about it. It's just a pretty simple IF block checking if a dictionary key exist or doesn't exist and performs different actions for both the conditions.
Featured Post
Question has a verified solution.
If you are experiencing a similar issue, please ask a related question
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
Suggested Courses
Course of the Month6 days, 11 hours left to enroll
726 members asked questions and received personalized solutions in the past 7 days.
Join the community of 500,000 technology professionals and ask your questions.