Code to restructure the rows

S

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!
 
Sort by date Sort by votes
Thanks you for the file:-
Towards the bottom of the list there are numbers in "D" that do not match in "A" such as below:-
(Also the Replace formula does not sort them, that's not a problem though)
[TABLE="width: 186"]
<colgroup><col width="64" style="width: 48pt;" span="2"> <col width="120" style="width: 90pt; mso-width-source: userset; mso-width-alt: 4266;"> <tbody>[TR]
[TD="class: xl65, width: 64, bgcolor: transparent, align: right"]1439[/TD]
[TD="class: xl66, width: 64, bgcolor: transparent"]variable[/TD]
[TD="class: xl66, width: 120, bgcolor: transparent"] [/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]1440[/TD]
[TD="class: xl66, bgcolor: transparent"]variation[/TD]
[TD="class: xl66, bgcolor: transparent"]513uhRohMuh-P[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]1441[/TD]
[TD="class: xl66, bgcolor: transparent"]variation[/TD]
[TD="class: xl66, bgcolor: transparent"]513uhRohMuh-P[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]1442[/TD]
[TD="class: xl66, bgcolor: transparent"]variation[/TD]
[TD="class: xl66, bgcolor: transparent"]513uhRohMuh-P[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]1443[/TD]
[TD="class: xl66, bgcolor: transparent"]variation[/TD]
[TD="class: xl66, bgcolor: transparent"]513uhRohMuh-P[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]1444[/TD]
[TD="class: xl66, bgcolor: transparent"]variation[/TD]
[TD="class: xl66, bgcolor: transparent"]513uhRohMuh-P[/TD]
[/TR]
</tbody>[/TABLE]

What would you like to do with this data.????
 
Upvote 0

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
MickG said:
Thanks you for the file:-
Towards the bottom of the list there are numbers in "D" that do not match in "A" such as below:-
(Also the Replace formula does not sort them, that's not a problem though)

What would you like to do with this data.????
Click to expand...

Thank you for spending time on this! All variation can be ignored, such as the one in your example and anything else because they are grouped correctly from what I see. The only rows where I have this problem is when the parent sku was not specified for child products and if the child products were not all created at the same time, in that case the tool assigns a link automatically with the parent id. Currently, I only see the issue when you see ID: trailing with numbers.
 
Upvote 0
Try this for results on sheet2.

Code: 
[COLOR="Navy"]Sub[/COLOR] MG30Nov02
'[COLOR="Green"][B]Mk3[/B][/COLOR]
[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, txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[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]
       txt = CleanString(CStr(Ray(n, 3)))
         
        [COLOR="Navy"]If[/COLOR] Not .exists(txt) [COLOR="Navy"]Then[/COLOR]
            ReDim R(1 To UBound(Ray, 1))
            R(1) = n
            .Add txt, Array(R, 1)
        [COLOR="Navy"]Else[/COLOR]
            Q = .Item(txt)
            Q(1) = Q(1) + 1
            Q(0)(Q(1)) = n
            .Item(txt) = 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"]If[/COLOR] .exists(CStr(Ray(n, 1))) [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 .Item(CStr(Ray(n, 1)))(1)
                [COLOR="Navy"]If[/COLOR] .Item(CStr(Ray(n, 1)))(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(CStr(Ray(n, 1)))(0)(p), Ac)) [COLOR="Navy"]Then[/COLOR]
                            nray(c, Ac) = Ray(.Item(CStr(Ray(n, 1)))(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] 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]
Function CleanString(strIn [COLOR="Navy"]As[/COLOR] String) [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] objRegex
    [COLOR="Navy"]Set[/COLOR] objRegex = CreateObject("vbscript.regexp")
    [COLOR="Navy"]With[/COLOR] objRegex
     .Global = True
     .Pattern = "[^\d]+"
    CleanString = .Replace(strIn, vbNullString)
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] Function
Regards Mick
 
Last edited:
Upvote 0
MickG said:
Try this for results on sheet2.


Regards Mick
Click to expand...

Nice and many thanks!! It ran clean in first shot.

BTW, the previous code also ran perfectly on another sheet that I downloaded from our second site, the setup on the other site is much cleaner and it doesn't have the "ID:" text issue in child column. You are really good at this :).

Thanks again!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
how to random all numbers
Replies
7
Views
280
Fluff
Fluff
E
  • Solved
Returning specific texts within a wide range of data coming from the Web
Replies
8
Views
299
Peter_SSs
Peter_SSs
C
  • Question Question
Suggest a pricing matrix for Adult/Concession/Junior ‘Flexi Season Ticket’.
Replies
2
Views
527
Chuky
C
D
  • Question Question
VBA to transfor set of data from column to rows
Replies
0
Views
682
danielalvz
D
J
  • Question Question
Need some help with permutation code, convert from one cell to a range
Replies
3
Views
437
johnnyL
J

Forum statistics

Threads
1,224,825
Messages
6,181,189
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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