Solved

Help Writing Excel Macro

Posted on 2011-02-21
5
226 Views
Last Modified: 2012-05-11
The Data worksheet is how my data is formatted.  There are an known number of rows, some could have 100, 3, or 1000.  The macro needs to loop until end of last row.

On the Result worksheet, it's stringing together all the similar part numbers.

Check the attached xls for an example. example.xls
0
Comment
Question by:michaelblitz
  • 2
  • 2
5 Comments
 
LVL 17

Expert Comment

by:Shinesh Premrajan
ID: 34948938
This created for the  row 7 of the work sheet, apply same for the rest of the cells

=CONCATENATE(Data!A7,"|",Data!B7," ",Data!C7,"|",REPLACE(Data!D7,5,1,"|"))


Hope this helps
0
 
LVL 92

Accepted Solution

by:
Patrick Matthews earned 500 total points
ID: 34949031
michaelblitz,

The following seems to be working for me.  It uses a "Dictionary of Dictionaries" approach as outlined in my article http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/A_3391-Using-the-Dictionary-Class-in-VBA.html

Sub MakeLists()
    
    Dim dicFront As Object
    Dim dicRear As Object
    Dim dicSecond As Object
    Dim arr As Variant
    Dim r As Long
    Dim LastR As Long
    Dim Make As String
    Dim Model As String
    Dim Years As Variant
    Dim Front As String
    Dim Rear As String
    Dim Concat As String
    Dim Entries As Variant
    
    With ThisWorkbook.Worksheets("Data")
        LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
        arr = .Range(.[a2], .Cells(LastR, "g")).Value
    End With
    
    Set dicFront = CreateObject("Scripting.Dictionary")
    Set dicRear = CreateObject("Scripting.Dictionary")
    
    For r = 1 To UBound(arr, 1)
        Make = arr(r, 1)
        Model = Trim(arr(r, 2) & " " & arr(r, 3))
        Years = Split(arr(r, 4) & "-", "-")
        Concat = Join(Array(Make, Model, Years(0), Years(1)), "|")
        Front = arr(r, 6)
        Rear = arr(r, 7)
        If Front <> "" Then
            If dicFront.Exists(Front) Then
                Set dicSecond = dicFront.Item(Front)
            Else
                Set dicSecond = CreateObject("Scripting.Dictionary")
                dicFront.Add Front, dicSecond
            End If
            dicSecond.Item(Concat) = Concat
        End If
        If Rear <> "" Then
            If dicRear.Exists(Rear) Then
                Set dicSecond = dicRear.Item(Rear)
            Else
                Set dicSecond = CreateObject("Scripting.Dictionary")
                dicRear.Add Rear, dicSecond
            End If
            dicSecond.Item(Concat) = Concat
        End If
    Next
    
    ThisWorkbook.Worksheets.Add
    [a1] = "Front"
    LastR = 1
    Entries = dicFront.Keys
    For r = 0 To UBound(Entries)
        LastR = LastR + 1
        Cells(LastR, 1) = Entries(r)
        Cells(LastR, 2) = Join(dicFront.Item(Entries(r)).Keys, "###")
    Next
    
    LastR = LastR + 2
    Cells(LastR, 1) = "Rear"
    Entries = dicRear.Keys
    For r = 0 To UBound(Entries)
        LastR = LastR + 1
        Cells(LastR, 1) = Entries(r)
        Cells(LastR, 2) = Join(dicRear.Item(Entries(r)).Keys, "###")
    Next
    
    Set dicSecond = Nothing
    Set dicFront = Nothing
    Set dicRear = Nothing
    
    MsgBox "Done"
    
End Sub

Open in new window


Patrick
0
 

Author Comment

by:michaelblitz
ID: 34949050
Hi matthewspatrick

Very nice but only one critic, right now you're using Front AND Rear to determine uniqueness.  Instead, it should be Front OR Rear.  For example,

A, B
A,
A, C
A, D

In your code you'd show 4 unique but in reality it's 1 unique front and 3 unique rears.  Did that make sense?  :)
0
 

Author Comment

by:michaelblitz
ID: 34949202
Oh wait nevermind my mistake :)
0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 34950265
michaelblitz,

Glad to help!  If you have not already done so, I would really appreciate it if you could please return to my article
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/A_3391-Using-the-Dictionary-Class-in-VBA.html
and click 'Yes' for the 'Was this helpful?' voting.

Patrick
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

856 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question