[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now


Excel script to organize similar data under one column

Posted on 2015-02-07
Medium Priority
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!
Question by:tomfolinsbee
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
LVL 31

Expert Comment

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

Author Comment

ID: 40596925
one time only. Thanks for your interest!
LVL 31

Expert Comment

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
last block finishes at column BD
and Be will be blank !!!

is this correct ?
Industry Leaders: 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

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).

LVL 31

Expert Comment

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

Expert Comment

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.
LVL 31

Expert Comment

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

Accepted Solution

Simon earned 2000 total points
ID: 40597246
Hi Tom, please try this.
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
        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
                    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


Author Comment

ID: 40599027
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!
LVL 18

Expert Comment

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?

Author Comment

ID: 40599351
Thanks simon!

About 3000 rows.

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

Thanks for your efforts on this!

Author Closing Comment

ID: 40599360
Thanks your help with this!

Author Comment

ID: 40603795

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


Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
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 demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

656 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