Solved

Excel script to organize similar data under one column

Posted on 2015-02-07
13
128 Views
Last Modified: 2016-02-11
Hello Experts
I have one sheet with several thousand rows containing part measurement data.  The parts are grouped by part type. The measurement units vary from group to group, so each column contains different types of measurements.

I would like some help with a script that will organize all similar data to a single column.

I've attached some sample data.

1. If  cell in row H = "No.",  then for each vertical array between column I:N and down to the next row where H=No., copy the vertical array of values over to the matching column 0:BE

2. If cells in column M or N are emtpy, then copy text over to columns BF and BG.

3. There should be a matching column in 0:BE for all other cases. If not, return error.

Thank you!
EE2015007.xlsx
0
Comment
Question by:tomfolinsbee
[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
  • 6
  • 4
  • 3
13 Comments
 
LVL 29

Expert Comment

by:gowflow
ID: 40596918
u need vba I guess ?
Is this a 1 time or repetitive ?
gowflow
0
 

Author Comment

by:tomfolinsbee
ID: 40596925
one time only. Thanks for your interest!
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40596934
you say Copy block I:N till you hit the first No
to O:BE

I:N = 6 columns
O:BE = 31 columns

so if we copy will be
first block O:T
second block U:Z
etc...
last block finishes at column BD
and Be will be blank !!!

is this correct ?
gowflow
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:tomfolinsbee
ID: 40596937
Idea is to copy each column in I:N separetely over to the column in O:BE with the matching header (measurement unit).

Thanks!
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40596941
Matching header !!!! ???? You are kidding it is in chineese !
gowflow
0
 
LVL 18

Expert Comment

by:Simon
ID: 40597016
Hi, I gave you a solution to your last one, Tom, and am working on one for this. I expect to have something for you in the next few hours (after family time).
@gowflow: for the last one I did unicode character code matching, but this one is a little easier in some ways.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40597049
good luck then Simon I will leave you to handle translation as not into this.
gowlfow
0
 
LVL 18

Accepted Solution

by:
Simon earned 500 total points
ID: 40597246
Hi Tom, please try this.
EE2015007.xlsm
It identifies header rows and matches them to correct columns and then processes all non-header rows below them cell by cell.
It returns an error for unmatched header cells, so you can debug or quit.
It ignores blank header cells, but reports error if a cell in the non-header rows below it have content. You can make it raise an error instead of message box by commenting line 42 and uncommenting line 43.
Examples of such errors are from rows 118 down to 125 and row 415.

Sub tf2()
Dim KeyRange As Range
Dim HeaderRange As Range
Dim MoveToCol(6) As Integer 'array to store the matching column numbers

Set KeyRange = Intersect(Range("H:H"), ActiveSheet.UsedRange)
Debug.Print KeyRange.Address
Set HeaderRange = Range("O1:BE1")

For Each c In KeyRange.Cells
    If c.Value = "No." Then
        Debug.Print "KeyRange Header ", c.Address, c.Value
        For i = 1 To 6
            findme = c.Offset(0, i).Value
            Debug.Print c.Offset(0, i).Address, "|" & findme & "|";
            Set matchresult = HeaderRange.Find(what:=findme, lookat:=xlWhole)
            If Not matchresult Is Nothing Then
                Debug.Print vbTab, matchresult.Address
                MoveToCol(i) = matchresult.Column
            ElseIf c.Offset(0, i) = "" And i = 5 Then
                Debug.Print vbTab, 58 & "(BF)"
                MoveToCol(i) = 58 'BF
            ElseIf c.Offset(0, i) = "" And i = 6 Then
                Debug.Print vbTab, 59 & "(BG)"
                MoveToCol(i) = 59 'BG
            Else 'no match for the header column title was found. This is ok if in cols 5&6, but not in 1-4.
                Debug.Print "Not found"
                MoveToCol(i) = 0
                If findme <> "" Then 'only raise error if header cell is non-blank. For blank headers, the content of the column will be checked row by row
                    Err.Raise vbObjectError + 1, "", "No match for header in cell " & c.Offset(0, i).Address & " with value " & c.Offset(0, i).Value
                End If
            End If
        Next i
    ElseIf c.Row = 1 Then
        'skip header row (I was just to lazy to define the range more accurately
    Else
        Debug.Print "KeyRange Content", c.Address, c.Value
        For i = 1 To 6
            If c.Offset(0, i).Value <> "" Then
                If MoveToCol(i) = 0 Then
                    Debug.Print "No match for header of cell " & c.Offset(0, i).Address & " with value " & c.Offset(0, i).Value
                    If MsgBox("No match for header of cell " & c.Offset(0, i).Address & " with value " & c.Offset(0, i).Value, vbOKCancel) = vbCancel Then Exit Sub Else
                    'Err.Raise vbObjectError + 1, "", "No match for header of cell " & c.Offset(0, i).Address & " with value " & c.Offset(0, i).Value
                Else
                    Debug.Print "Cell " & Cells(c.Row, MoveToCol(i)).Address & " will receive value from " & c.Offset(o, i).Address
                    Cells(c.Row, MoveToCol(i)).Value = c.Offset(0, i).Value
                End If 'MoveTo
            End If 'cell value <>""
        Next i
    End If
Next c
MsgBox "Finished"
End Sub

Open in new window

0
 

Author Comment

by:tomfolinsbee
ID: 40599027
Simon
Thanks for this.  Would you mind modifying so that there no labels in the top tow to start, and new labels are added whenever a new label  is encountered will the script is looping through? I created the top row labels using excel remove duplicates, but could have missed some or perhaps ilchanged encoding???

Really appreciate your help with this!
0
 
LVL 18

Expert Comment

by:Simon
ID: 40599252
Hi Tom, with respect, that's a new request. This solution was based on matching to an existing range of headers and writing to fixed pair of column if M:N headers were blank. I'll happily help if you sign this one off and ask a new question, but this has taken enough time to solve, and what you're asking now seems like a significant change of scope.

Out of interest are you asking because you found lots of unmatched headers when you ran the code above on your live data?
How many rows of live data do you have to go through?
0
 

Author Comment

by:tomfolinsbee
ID: 40599351
Thanks simon!

About 3000 rows.

I understand the error messages now. The data looks fine.

Thanks for your efforts on this!
0
 

Author Closing Comment

by:tomfolinsbee
ID: 40599360
Thanks your help with this!
0
 

Author Comment

by:tomfolinsbee
ID: 40603795
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28614962.html

I've created a new question
1) error around record 600 in the full recordset
2) request to automatically generate new labels in top row

Thanks!
0

Featured Post

PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
any combination of this numbers 9 33
Tricky Shapes formula 3 18
Checking references in VBA 3 25
Access Excel ADO SQL question 8 12
A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

730 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