Row sorting problem.Need to place row data into correct columns

TerryChristiansohn

New Member
Joined
Feb 11, 2013
Messages
11
Hello. I only know how to record macro's; nothing else, so I cannot even call myself a newbie. But I need help with data that comes to me all jumbled up.

1. Each farmer grows certain types of fruit. The farmer's and the farmer's country is in one row; that same row also contains the fruit that farmer grows.
2. The the types of fruit that farmer grows arrives to me scrambled as per its category.
3. Each fruit has its own category: cherries, berries, citrus, Stone Fruit, apples, melons. You can tell which category each fruit belongs to, for example, each apple variety is preceded by the string "apples:" in the cell.
4. The fruit needs to be sorted into the correct columns as per the row headers.
5. The fruit needs to stay in the same row, so that we always know which farmer grows what fruit, and which country that fruit has been grown in.
6. The index number, the farmer's name and the country must remain in columns A, B, C.


[TABLE="width: 959"]
<colgroup><col width="131"><col width="132"><col width="150"><col width="142"><col width="86"><col width="134"><col width="184"></colgroup><tbody>[TR]
[TD="class: xl22, width: 184"][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
TerryChristiansohn,

What version of Excel are you using?

Can you post a screenshot of the raw data worksheet, and, post a screenshot of the worksheet results (manually formatted by you) that you are looking for?

To post your data, you can download and install one of the following two programs:
Excel Jeanie
MrExcel HTML Maker
Or, when using Internet Explorer, just put borders around your data in Excel and copy those cells into your post.

If you are not able to give us screenshots:
You can upload your workbook to Box Net,
sensitive data scrubbed/removed/changed
mark the workbook for sharing
and provide us with a link to your workbook.


If posting VBA code, please use Code Tags - like this:

[code]

'Paste your code here.

[/code]
 
Upvote 0
TerryChristiansohn,

Thanks for the workbook.


Sample raw data in the first (most left worksheet) in the workbook (notice cell H6 has no leading identifier):


Excel Workbook
ABCDEFGHIJ
1IndexGrowerCountrytropicalcherriesberriescitrusStone Fruitapplesmelons
21Georgia FarmsGeorgiacitrus: tangerinetropical: mangomelons: cantaloupeberries: Bilberrystone:Apricotscherries: Rainierapples: gravenstein
32Berries n' MoreUSAberries: Cape Gooseberrycherries: Lapincitrus: tangeloapples: golden delicioustropical: bananastone:Nectarinesmelons: Casaba
43Heathcliff Greenhouses LtdUnited Kingdomtropical: starfruitberries: RiberryPeachescitrus: kumquatapples: fujicherries: Vanmelons: Crenshaw
54Innotec GrowersCanadacherries: Bingcitrus: orangeapples: galatropical: passionfruitmelons: Honeydewberries: Indian Gooseberrystone:White peach
65Best OrganicUSAberries: Riberrycitrus: limecherries: lamberttropical: lichiiplummelons: Juan Canaryapples: granny smith
76Toutes Les FruitsFranceberries: Acaimelons: Orange-flesh Honeydewapples: McIntoshstone:prunetropical: longancherries: Skeenacitrus: grapefruit
87Maccedonia di FruitaItalyapples: pippintropical: pineapplecherries: Sweetheartcitrus: lemonberries: Blueberrymelons: Pepino
98Delicious TropicFijimelons: Persiantropical: coconutberries: Black Berrycitrus: Bergamot orangeapples: pink ladycherries: Queen Anne
109Small Farmers ClubNew Zealandcherries: Blackapples: braeburnberries: Raspberrymelons: Santa Claustropical: cherimolacitrus: Cleopatra Mandarin
1110Certified Organic Fruit GrowersUSAcherries: Choketropical: Rambutanapples: Honeycrispmelons: Seedless Watermelonberries: Mulberrycitrus: Ponderosa lemon
1211Master GardenersUnited Kingdomtropical: guavamelons: Watermelonberries: Strawberrycherries: Maraschinoapples: Arkansas Blackcitrus: Orangelo
1312MastrichtNeatherlandscitrus: Persian limecherries: Morelloberries: Red Mulberrymelons: Yellow-Flesh WatermelonTropical: orange papaya
1413Herbs de Bon SanteFrancemelons: wintermeloncitrus: Palestine sweet limeberries: Logan Berry
1514Belle TropicaleTahitiberries: Lingonberrycherries: North Starcitrus: Pompia
1615Oceana FarmersNew Zealandcitrus: kaffir limecherries: Spanish Cherryberries: Huckleberry
1716Mexico FruitasMexicocitrus: Limettacherries: Tietonberries: Goji berry
1817Northlights OrganicCanadaberries: Elderberry
1918Eastern Seasonal Specialtiesapples: Arkansas Blackstone:pruneberries: Cranberrycherries: tart
20
Original Scrambled Data





After the macro in a new worksheet Results:


Excel Workbook
ABCDEFGHIJ
1IndexGrowerCountrytropicalcherriesberriescitrusStone Fruitapplesmelons
21Georgia FarmsGeorgiatropical: mangocherries: Rainierberries: Bilberrycitrus: tangerinestone:Apricotsapples: gravensteinmelons: cantaloupe
32Berries n' MoreUSAtropical: bananacherries: Lapinberries: Cape Gooseberrycitrus: tangelostone:Nectarinesapples: golden deliciousmelons: Casaba
43Heathcliff Greenhouses LtdUnited Kingdomtropical: starfruitcherries: Vanberries: Riberrycitrus: kumquatapples: fujimelons: Crenshaw
54Innotec GrowersCanadatropical: passionfruitcherries: Bingberries: Indian Gooseberrycitrus: orangestone:White peachapples: galamelons: Honeydew
65Best OrganicUSAtropical: lichiicherries: lambertberries: Riberrycitrus: limeapples: granny smithmelons: Juan Canary
76Toutes Les FruitsFrancetropical: longancherries: Skeenaberries: Acaicitrus: grapefruitstone:pruneapples: McIntoshmelons: Orange-flesh Honeydew
87Maccedonia di FruitaItalytropical: pineapplecherries: Sweetheartberries: Blueberrycitrus: lemonapples: pippinmelons: Pepino
98Delicious TropicFijitropical: coconutcherries: Queen Anneberries: Black Berrycitrus: Bergamot orangeapples: pink ladymelons: Persian
109Small Farmers ClubNew Zealandtropical: cherimolacherries: Blackberries: Raspberrycitrus: Cleopatra Mandarinapples: braeburnmelons: Santa Claus
1110Certified Organic Fruit GrowersUSAtropical: Rambutancherries: Chokeberries: Mulberrycitrus: Ponderosa lemonapples: Honeycrispmelons: Seedless Watermelon
1211Master GardenersUnited Kingdomtropical: guavacherries: Maraschinoberries: Strawberrycitrus: Orangeloapples: Arkansas Blackmelons: Watermelon
1312MastrichtNeatherlandsTropical: orange papayacherries: Morelloberries: Red Mulberrycitrus: Persian limemelons: Yellow-Flesh Watermelon
1413Herbs de Bon SanteFranceberries: Logan Berrycitrus: Palestine sweet limemelons: wintermelon
1514Belle TropicaleTahiticherries: North Starberries: Lingonberrycitrus: Pompia
1615Oceana FarmersNew Zealandcherries: Spanish Cherryberries: Huckleberrycitrus: kaffir lime
1716Mexico FruitasMexicocherries: Tietonberries: Goji berrycitrus: Limetta
1817Northlights OrganicCanadaberries: Elderberry
1918Eastern Seasonal Specialtiescherries: tartberries: Cranberrystone:pruneapples: Arkansas Black
20
Results





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Code:
Option Explicit
Sub ReorgData()
' hiker95, 02/12/2013
' http://www.mrexcel.com/forum/excel-questions/685028-row-sorting-problem-need-place-row-data-into-correct-columns.html
Dim w1 As Worksheet, wR As Worksheet
Dim a As Variant, b As Variant
Dim r As Long, c As Long, lr As Long, lc As Long
Set w1 = Worksheets(1)
lr = w1.Cells(Rows.Count, 1).End(xlUp).Row
lc = w1.Cells(1, Columns.Count).End(xlToLeft).Column
a = w1.Range(Cells(1, 1), Cells(lr, lc))
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
b(1, 1) = a(1, 1): b(1, 2) = a(1, 2): b(1, 3) = a(1, 3): b(1, 4) = a(1, 4)
b(1, 5) = a(1, 5): b(1, 6) = a(1, 6): b(1, 7) = a(1, 7): b(1, 8) = a(1, 8)
b(1, 9) = a(1, 9): b(1, 10) = a(1, 10)
For r = 2 To lr Step 1
  b(r, 1) = a(r, 1): b(r, 2) = a(r, 2): b(r, 3) = a(r, 3)
  For c = 4 To lc Step 1
    If a(r, c) <> "" Then
      Select Case Left(LCase(a(r, c)), 2)
        Case "tr"   '4
          b(r, 4) = a(r, c)
        Case "ch"   '5
          b(r, 5) = a(r, c)
        Case "be"   '6
          b(r, 6) = a(r, c)
        Case "ci"   '7
          b(r, 7) = a(r, c)
        Case "st"   '8
          b(r, 8) = a(r, c)
        Case "ap"   '9
          b(r, 9) = a(r, c)
        Case "me"   '10
          b(r, 10) = a(r, c)
      End Select
    End If
  Next c
Next r
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
wR.Range(Cells(1, 1), Cells(lr, lc)) = b
wR.Cells.EntireColumn.AutoFit
End Sub


Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the ReorgData macro.
 
Upvote 0
Thank you so much! I will try it later today and let you know if it works. And thank you for catching the mistake on the lack of header identifier for the "prune" on cell c6.
 
Upvote 0
Wow !! You are a genius! It worked so well, so quickly. A split second and it was DONE!!
I was wondering: on the original Excel file, the cells were colored to correspond with their category (tropical, berries, apples, etc). Can the macro you wrote be modified to preserve the color? Reason I am asking is that my vision, even though I wear eyeglasses, is not very strong, and having the colors to look at helps me to identify the cell I need to focus my attention on. Thank you again. I so appreciate the effort and care you put into this.
 
Upvote 0
TerryChristiansohn,


Can the macro you wrote be modified to preserve the color?

Here you go.


After the updated macro:


Excel Workbook
ABCDE
1IndexGrowerCountrytropicalcherries
21Georgia FarmsGeorgiatropical: mangocherries: Rainier
32Berries n' MoreUSAtropical: bananacherries: Lapin
43Heathcliff Greenhouses LtdUnited Kingdomtropical: starfruitcherries: Van
54Innotec GrowersCanadatropical: passionfruitcherries: Bing
65Best OrganicUSAtropical: lichiicherries: lambert
76Toutes Les FruitsFrancetropical: longancherries: Skeena
87Maccedonia di FruitaItalytropical: pineapplecherries: Sweetheart
98Delicious TropicFijitropical: coconutcherries: Queen Anne
109Small Farmers ClubNew Zealandtropical: cherimolacherries: Black
1110Certified Organic Fruit GrowersUSAtropical: Rambutancherries: Choke
1211Master GardenersUnited Kingdomtropical: guavacherries: Maraschino
1312MastrichtNeatherlandsTropical: orange papayacherries: Morello
1413Herbs de Bon SanteFrance
1514Belle TropicaleTahiticherries: North Star
1615Oceana FarmersNew Zealandcherries: Spanish Cherry
1716Mexico FruitasMexicocherries: Tieton
1817Northlights OrganicCanada
1918Eastern Seasonal Specialtiescherries: tart
20
Results





Excel Workbook
FGHIJ
1berriescitrusStone Fruitapplesmelons
2berries: Bilberrycitrus: tangerinestone:Apricotsapples: gravensteinmelons: cantaloupe
3berries: Cape Gooseberrycitrus: tangelostone:Nectarinesapples: golden deliciousmelons: Casaba
4berries: Riberrycitrus: kumquatapples: fujimelons: Crenshaw
5berries: Indian Gooseberrycitrus: orangestone:White peachapples: galamelons: Honeydew
6berries: Riberrycitrus: limeapples: granny smithmelons: Juan Canary
7berries: Acaicitrus: grapefruitstone:pruneapples: McIntoshmelons: Orange-flesh Honeydew
8berries: Blueberrycitrus: lemonapples: pippinmelons: Pepino
9berries: Black Berrycitrus: Bergamot orangeapples: pink ladymelons: Persian
10berries: Raspberrycitrus: Cleopatra Mandarinapples: braeburnmelons: Santa Claus
11berries: Mulberrycitrus: Ponderosa lemonapples: Honeycrispmelons: Seedless Watermelon
12berries: Strawberrycitrus: Orangeloapples: Arkansas Blackmelons: Watermelon
13berries: Red Mulberrycitrus: Persian limemelons: Yellow-Flesh Watermelon
14berries: Logan Berrycitrus: Palestine sweet limemelons: wintermelon
15berries: Lingonberrycitrus: Pompia
16berries: Huckleberrycitrus: kaffir lime
17berries: Goji berrycitrus: Limetta
18berries: Elderberry
19berries: Cranberrystone:pruneapples: Arkansas Black
20
Results





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


Code:
Option Explicit
Sub ReorgDataV2()
' hiker95, 02/12/2013
' http://www.mrexcel.com/forum/excel-questions/685028-row-sorting-problem-need-place-row-data-into-correct-columns.html
Dim w1 As Worksheet, wR As Worksheet
Dim a As Variant, b As Variant
Dim r As Long, c As Long, lr As Long, lc As Long
Application.ScreenUpdating = False
Set w1 = Worksheets(1)
lr = w1.Cells(Rows.Count, 1).End(xlUp).Row
lc = w1.Cells(1, Columns.Count).End(xlToLeft).Column
a = w1.Range(Cells(1, 1), Cells(lr, lc))
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
b(1, 1) = a(1, 1): b(1, 2) = a(1, 2): b(1, 3) = a(1, 3): b(1, 4) = a(1, 4)
b(1, 5) = a(1, 5): b(1, 6) = a(1, 6): b(1, 7) = a(1, 7): b(1, 8) = a(1, 8)
b(1, 9) = a(1, 9): b(1, 10) = a(1, 10)
For r = 2 To lr Step 1
  b(r, 1) = a(r, 1): b(r, 2) = a(r, 2): b(r, 3) = a(r, 3)
  For c = 4 To lc Step 1
    If a(r, c) <> "" Then
      Select Case Left(LCase(a(r, c)), 2)
        Case "tr"   '4
          b(r, 4) = a(r, c)
        Case "ch"   '5
          b(r, 5) = a(r, c)
        Case "be"   '6
          b(r, 6) = a(r, c)
        Case "ci"   '7
          b(r, 7) = a(r, c)
        Case "st"   '8
          b(r, 8) = a(r, c)
        Case "ap"   '9
          b(r, 9) = a(r, c)
        Case "me"   '10
          b(r, 10) = a(r, c)
      End Select
    End If
  Next c
Next r
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
wR.Range(Cells(1, 1), Cells(lr, lc)) = b
wR.Cells.EntireColumn.AutoFit
With wR.Range("A1").Resize(, lc)
  .Interior.ColorIndex = 43
  .Font.Underline = xlUnderlineStyleSingle
End With
For r = 2 To lr Step 1
  If wR.Cells(r, 4) <> "" Then wR.Cells(r, 4).Interior.ColorIndex = 40
Next r
For r = 2 To lr Step 1
  If wR.Cells(r, 5) <> "" Then wR.Cells(r, 5).Interior.ColorIndex = 7
Next r
For r = 2 To lr Step 1
  If wR.Cells(r, 6) <> "" Then wR.Cells(r, 6).Interior.ColorIndex = 39
Next r
For r = 2 To lr Step 1
  If wR.Cells(r, 7) <> "" Then wR.Cells(r, 7).Interior.ColorIndex = 6
Next r
For r = 2 To lr Step 1
  If wR.Cells(r, 8) <> "" Then wR.Cells(r, 8).Interior.ColorIndex = 40
Next r
For r = 2 To lr Step 1
  If wR.Cells(r, 9) <> "" Then wR.Cells(r, 9).Interior.ColorIndex = 45
Next r
For r = 2 To lr Step 1
  If wR.Cells(r, 10) <> "" Then wR.Cells(r, 10).Interior.ColorIndex = 35
Next r
wR.Activate
Application.ScreenUpdating = True
End Sub


Then run the ReorgDataV2 macro.
 
Upvote 0
Wow! It worked so perfectly! You are totally amazing. Thank you!
I was wondering if a macro is extensible. Actually, I don't even know if "extensible" is the correct word to describe this hypothetical situation:

1. A certain worksheet for charitable contributions contains only five columns containing data that needs to be categorized into its correct rows.
2. A certain worksheet for health data has 30 columns containing data that needs to be categorized into its correct rows.
3. Another hypothetical worksheet contains x number of rows and y number of columns.

Each of the above worksheets have a HUGE number of rows that (at least 50,000), so the macro would need to iterate until the last row is processed. I will upload a real-life example after I get home from work.

Again, thank you. This is a real eye-opener for me.
 
Upvote 0
TerryChristiansohn,

Thanks for the feedback.

You are very welcome. Glad I could help.

Looking forward to hearing from you later.
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,099
Members
452,301
Latest member
QualityAssurance

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