You are here:

Excel/VBA to make new columns


Before the VBA
Before the VBA  
After the VBA
After the VBA  
I generally have a good idea what needs to be done to create a VBA that will do what I need to do but I'm at a loss here.  I receive a report that has several columns of biographical data. On the very last two columns, it has ID Category and next column has the actual number.  The ID Category can be one of ten different IDs and so I'll have several rows of same data but different ID Category.  So I want to make it so that I get one unique row which means appending up to ten columns.  I've attached images of the spreadsheet of before and after.  I'm pretty good with logic but when it comes to loops, it throws me off.  Any help would be very much appreciated.  Thank you.


If you just want logic, then I would first sort the data.  Then you only have to loop through the data once.  I would write the category names in additional columns on the right.  

Then I would loop through the data and see if the current record/row is the first occurance of the individual.  If it is, I would remember that row (assign the row number as a variable), then as the loop continues, I would compare the individual's identification to see if it is still for that individual.  If it is, I would write the ID to the correct category column on the matching first occurance row.  

If it does not match the existing first occurance, then I would identify this row as the first occurance for the next person.  Each time I identified a new first occurance, I would put the ID on that row under the correct category column.

I would also use an adjacent column to mark which rows are not first occurances.   

Then after processing all the records, I would look a that extra column to delete the rows which were not first occurance.   I would also delete the original columns for ID Category and ID.  

Does that help?  

Tom Ogilvy

---------- FOLLOW-UP ----------

QUESTION: Yes sort of.  I can sort and create the columns without much issues but now that I know the logic, I'm having hard time executing it as I'm not very good with loops.  Not sure what code would suffice the first occurance of the individual and rest of the macro.  Did some search trying to see a similar issue but wasn't able to find anything.


Here is the code which I tested with your data and it appeared to work.

In the Array(...) put in the 10 categories.  Make sure there are no misspellings from what is in column J in your data.  

This first sorts you data by column A.  If you don't want that sort (and each persons data is contiguous - in otherwords, the data is already sorted, then you can remove the command

r.Sort Key1:=sh.Range("A1"), order1:=xlAscending, _
Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom

change the command

set sh = worksheets("Datasheet")   to reflect your sheet name.  or if you want to run on the activesheet, you can change it to

set sh = ActiveSheet

It assumes you header UNIQUE ID is in A1 of that sheet and there are no blank entries in column A.   

Sub CombineRows()
Dim sh As Worksheet, r As Range
Dim v As Variant, rw As Long, res As Variant
Dim lastrw As Long, strtrw As Long, UID As String
Dim bFirst As Boolean, r1 As Range
   "BIRTH CERT", "ALIEN NUMBER", "ID7", "ID8", "ID9", "ID10")

Set sh = Worksheets("Datasheet")
Set r = sh.Range("A1").CurrentRegion
r.Sort Key1:=sh.Range("A1"), order1:=xlAscending, _
Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom
sh.Range("L1").Resize(1, 10).Value = v

UID = ""
lastrw = r(r.Count).Row
rw = 2
Do While rw < lastrw + 1
 If sh.Cells(rw, "A") <> UID Then
    bFirst = True
    res = Application.Match(sh.Cells(rw, "J").Value, v, 0)
    UID = sh.Cells(rw, "A").Value
    strtrw = rw
    bFirst = False
 End If
 res = Application.Match(sh.Cells(rw, "J").Value, v, 0)
 If Not IsError(res) Then
     sh.Cells(strtrw, "K").Offset(0, res).Value = sh.Cells(rw, "K").Value
     If Not bFirst Then sh.Cells(rw, "V").Formula = "=na()"
 End If
 rw = rw + 1
On Error Resume Next
Set r1 = sh.Range("V:V").EntireColumn.SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not r1 Is Nothing Then
End If
End Sub
Tom Ogilvy  
About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here


All Answers

Answers by Expert:

Ask Experts


Tom Ogilvy


Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]


Extensive experience.

Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2017 All rights reserved.