Code to restructure the rows

scorleo

New Member
Joined
Nov 29, 2017
Messages
9
Hello All,

I have never done programming in VB so this is fairly new, had done some PB programming more than 20 years ago but can't remember anything :(. I exhausted in-built sort option Excel provides for what I want to achieve.

I need some help in restructuring data that I download frequently from a website for products and upload them after updating prices and some other information. The issue I run into is that some of the parent and child records are scattered and I often have to manually move the rows to make updates resulting in hours of lost time. Since we download and upload it frequently I think it makes sense to write a macro for restructuring the rows.

Here's an example of the data that we download:

[TABLE="width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Short Desc[/TD]
[TD]Parent[/TD]
[TD]Reg Price[/TD]
[TD]Sale Price[/TD]
[TD]lots of other cols.[/TD]
[/TR]
[TR]
[TD]660[/TD]
[TD]Product 1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]...[/TD]
[/TR]
[TR]
[TD]661[/TD]
[TD]Product 2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]...[/TD]
[/TR]
[TR]
[TD]662[/TD]
[TD][/TD]
[TD]661[/TD]
[TD]45[/TD]
[TD]40[/TD]
[TD]...[/TD]
[/TR]
[TR]
[TD]663[/TD]
[TD][/TD]
[TD]660[/TD]
[TD]50[/TD]
[TD]44[/TD]
[TD]...[/TD]
[/TR]
[TR]
[TD]664[/TD]
[TD][/TD]
[TD]660[/TD]
[TD]44[/TD]
[TD]23[/TD]
[TD]...[/TD]
[/TR]
[TR]
[TD]665[/TD]
[TD]Product 3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]...[/TD]
[/TR]
[TR]
[TD]666[/TD]
[TD][/TD]
[TD]661[/TD]
[TD]55[/TD]
[TD]55[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]667[/TD]
[TD][/TD]
[TD]661[/TD]
[TD]12[/TD]
[TD]11[/TD]
[TD]...[/TD]
[/TR]
[TR]
[TD]668[/TD]
[TD][/TD]
[TD]665[/TD]
[TD]10[/TD]
[TD]9[/TD]
[TD]...[/TD]
[/TR]
[TR]
[TD]...[/TD]
[TD][/TD]
[TD]...[/TD]
[TD]...[/TD]
[TD]...[/TD]
[TD]...[/TD]
[/TR]
</tbody>[/TABLE]

ID is just a running number when each new product is created in the system. Parent col is empty when it's a parent record, if it has ID in it then it's a child product and it's linked to the Parent product. In this case, I'd like the code to move rows 4 and 5 from above table below row 1, example below:

[TABLE="width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Short Desc[/TD]
[TD]Parent[/TD]
[TD]Reg Price[/TD]
[TD]Sale Price[/TD]
[/TR]
[TR]
[TD]660[/TD]
[TD]Product 1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]663[/TD]
[TD][/TD]
[TD]660[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]664[/TD]
[TD][/TD]
[TD]660[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]661[/TD]
[TD]Product 2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]662[/TD]
[TD][/TD]
[TD]661[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]666[/TD]
[TD][/TD]
[TD]661[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]667[/TD]
[TD][/TD]
[TD]661[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]665[/TD]
[TD]Product 3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I'm using Office 2016 version.

Thanks in advance!
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Try this for results on sheet2.

To Save and Run Code:-
Copy code from Thread
In Your Data sheet , Click "Alt+F11",:- Vb Window appears.
From the VBWindow toolbar, Click "Insert" ,"Module":- New VBwindow appears .
Paste Code into this window.
Close Vbwindow.
On sheet Click "Developer tab", Click "Macro". Macro dialog box appears.
Select Macro (with same name) from List.
On the right of Dialog box Click "Run"
Sheet2 should now be updated.





Code:
[COLOR=navy]Sub[/COLOR] MG30Nov39
[COLOR=navy]Dim[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Q [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] col [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] k [COLOR=navy]As[/COLOR] Variant, p [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
Ray = ActiveSheet.Cells(1).CurrentRegion
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
ReDim nray(1 To UBound(Ray, 1), 1 To UBound(Ray, 2))
[COLOR=navy]For[/COLOR] Ac = 1 To UBound(Ray, 2)
    nray(1, Ac) = Ray(1, Ac)
[COLOR=navy]Next[/COLOR] Ac
c = 1
    [COLOR=navy]For[/COLOR] n = 2 To UBound(Ray, 1)
        [COLOR=navy]If[/COLOR] Not IsEmpty(Ray(n, 3)) [COLOR=navy]Then[/COLOR]
        [COLOR=navy]If[/COLOR] Not .Exists(Ray(n, 3)) [COLOR=navy]Then[/COLOR]
            ReDim R(1 To UBound(Ray, 1))
            R(1) = n
            .Add Ray(n, 3), Array(R, 1)
        [COLOR=navy]Else[/COLOR]
            Q = .Item(Ray(n, 3))
            Q(1) = Q(1) + 1
            Q(0)(Q(1)) = n
            .Item(Ray(n, 3)) = Q
        [COLOR=navy]End[/COLOR] If
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] n
[COLOR=navy]Dim[/COLOR] t
[COLOR=navy]For[/COLOR] n = 2 To UBound(Ray, 1)
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] k [COLOR=navy]In[/COLOR] .keys
        [COLOR=navy]If[/COLOR] k = Ray(n, 1) And Not IsEmpty(Ray(n, 2)) [COLOR=navy]Then[/COLOR]
            c = c + 1
            nray(c, 1) = Ray(n, 1): nray(c, 2) = Ray(n, 2)
            [COLOR=navy]For[/COLOR] p = 1 To UBound(Ray, 1)
                [COLOR=navy]If[/COLOR] .Item(k)(0)(p) <> "" [COLOR=navy]Then[/COLOR]
                    c = c + 1
                    [COLOR=navy]For[/COLOR] Ac = 1 To UBound(Ray, 2)
                        [COLOR=navy]If[/COLOR] Not IsEmpty(Ray(.Item(k)(0)(p), Ac)) [COLOR=navy]Then[/COLOR]
                            nray(c, Ac) = Ray(.Item(k)(0)(p), Ac)
                        [COLOR=navy]End[/COLOR] If
                    [COLOR=navy]Next[/COLOR] Ac
                [COLOR=navy]End[/COLOR] If
           [COLOR=navy]Next[/COLOR] p
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] k
[COLOR=navy]Next[/COLOR] n
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(UBound(Ray, 1), UBound(Ray, 2))
    .Value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=navy]End[/COLOR] With

[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Try this for results on sheet2.

Regards Mick

Thanks Mick. Unfortunately, I'm getting this error message
hh9unj
http://prntscr.com/hh9unj

First I thought it was because of sheet name so I changed it from Sheet2 to Sheet1 and I still get the error, I don't have Sheet1 in my workbook currently.

Thanks again!
 
Upvote 0
Thank you Mick!

The code works but here's what I had to do, cell number 3 (Parent2) uses a formula to remove "ID:" from another col called Parent, because of use of formula it was giving errors. When I hard coded the numbers to run a test it moved the rows perfectly the way I want.

However, my key issue still remains because the Parent column includes "ID:", the current code results in mismatch error as before. Here's my actual column sample --> http://prntscr.com/hhadbi
 
Upvote 0
Is it possible to send the file (or accurate example of) with limited expected results, using www.box.com (free file sharing) or similar, so I can see the actual problems.
NB:- Images need to be manually copied to the sheet and not all details are apparent !!!
 
Upvote 0
Is it possible to send the file (or accurate example of) with limited expected results, using www.box.com (free file sharing) or similar, so I can see the actual problems.
NB:- Images need to be manually copied to the sheet and not all details are apparent !!!

Just sent in a private message. Thanks a lot!
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top