Kidza
Kidza

Reputation: 11

Excel VBA Code to transpose multiple columns into multiple rows

Can somebody please help, i'm a newbie in VBA, i would like to thank you in advance for your help. If there are any links where my question has already been adressed please point me in the right direction. I have searched here and on other sites but i couldn't find anything that atleast get me started. I would like to create VBA code that loops through cells in every row and transpose them into seperate rows as illustrated below.

I have an excel spreadsheet with 12000 rows of data and multiple columns. For each row i have columns "A" to "Q" as static fields. Name, DOB, ID_Number, e.t.c. From columns "Q" to "DD", i have repeated data on "City" and "RegDate" columns, for example: City1, RegDate1, City2, RegDate2, City3, RegDate3,..& CityN, RegDateN. The City names are used as Headers and the data cells show "R" under every city where a person is registered and the registration date in the column next to it, otherwise there is no entry.

I would like to transform this data so that for every City where a person is registered, i will have a new row of data showing the static fields "A" to "P", "City", and "RegDate" i.e. after column "P" i will only have two columns "City" and "RegDate".

I'm really struggling with creating code that loops from Column Q to Column DD creating a new row when ever an "R" is encountered copying rows Columns "A" to "P" and inserting the Name of the City in the new column "Q" and the RegDate in the new Column "R", before moving on to the next row until all the 12000 rows have been transformed.

Any help to get me started would be greatly appreciated especially on setting up the looping that creates a new role for every record with an "R" encountered.

Upvotes: 0

Views: 4826

Answers (1)

Aaron Thomas
Aaron Thomas

Reputation: 5281

Have you considered just putting this information in two new columns to the far right (DE and DF)? Then you could either hide Q to DD, or delete those columns.

As for the looping code to do this:

Dim cr As Long 'current row
Dim cc As Long 'current column
For cr = 2 To 12000
  For cc = 17 To 108 Step 2
    If Cells(cr, cc).Value = "R" Then
      'make column 109 (DE) in current row = city name
      Cells(cr, 109).Value = Cells(1, cc).Value
      'make column 110 (DF) in current row = date of registration
      Cells(cr, 110).Value = Cells(cr, cc + 1).Value
    End If
  Next
Next

Upvotes: 0

Related Questions