VBA convert rows to columns

Question

I try to make convertion from TABLE1 to TABLE2

using vba

code should go here, but when i paste it, i got erro that I have to much    code

so, i add link to TXT document vba code

but can't figure out how to move the YEAR data from TABLE1 B1:G1 to column B of TABLE2.

Answer 1

Assuming you use the Setup as shown in your example, this worked for me:

Sub tt()

Dim ws As Worksheet, nws As Worksheet
Dim i As Long, j As Long, c As Long
Set ws = ActiveSheet
Set nws = Worksheets.Add
i = 0
c = 0

nws.Range("A1").Value = "Country"
nws.Range("B1").Value = "Year"
nws.Range("C1").Value = "Value"
nws.Range("D1").Value = "Text"
Do While ws.Cells(2 + i, 1).Value <> ""
    j = 0
    Do While ws.Cells(1, 2 + j).Value <> ""

        nws.Cells(2 + c, 1).Value = ws.Cells(2 + i, 1).Value
        nws.Cells(2 + c, 2).Value = ws.Cells(1, 2 + j).Value
        nws.Cells(2 + c, 3).Value = ws.Cells(2 + i, 2 + j).Value
        nws.Cells(2 + c, 4).Value = "YES"
        c = c + 1
        j = j + 1
    Loop
    i = i + 1
Loop

End Sub

---

For a non-VBa Solution, you can do this with the native Worksheets-Functions like such:

Assuming you have the setup like in the picture put these Formulas in A9, B9 and C9 and drag down as suited:

For A9;

=INDIRECT(CONCATENATE("A",ROUNDDOWN((ROW(1:1)-1)/COUNTA($B$2:$G$2),0)+3))

For B9:

=INDEX($B$2:$G$2,MOD((ROW(1:1)-1),COUNTA($B$2:$G$2))+1)

For C9:

=INDEX($A$3:$G$5,MATCH(E9,$A$3:$A$5,0),MOD(ROW(1:1)-1,COUNTA($B$2:$G$2))+2)

Answer 2

K, might aswell give you some hints on how I would do this based on the information I have.

I recon there's a ton of ways to achieve this...

• by automating a PivotTable-Object
• by creating a Recordset, then looping it's records and field-names as shown in this example
• by looping your Table1-Range in the x and y direction (like you do)
• or, as described below, using a QueryTable with some basic SQL

Using a query table:

A query table is basically a link to some external data (a textfile, a database, another excel-doc).

Points i like about query tables:

• connects to virtually any data source
• needs to be set-up once, can be refreshed afterwards
• changes to it's content (filters, additional columns, order, calculated fields) can be made with basic SQL-knowledge, eliminating the need to overthink some VBA-logic.

For our purpose, it is largely described with two properties (there's more to it, but we keep it simple):

• The Connection / ConnectionString stores information on your linked data (filetype, location, etc). In our case, this is the exact Excel-File we're working on. Check out connectionstrings.com for more info on other fiole-types.

  Here's how your Connection will likely look, assuming you use an xlsm-File:

  OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;;Password=;User ID=Admin;
  Mode=Share Deny Write;
  Data Source=I:\yourfolder\ThisFile.xlsm;
  Extended Properties="Excel 12.0 Macro;HDR=YES"
  

  To keep things simple, paste this into one cell and read it into a string-variable with con = YourSheet.Cells(1,1). Editing it in a cell is a lot more comfortable than inside VBA.

• the CommandText stores information on what data to get. We use CommandType = xlCmdSql here, which means that our CommandText will be an SQL-String, closely resembling this one:

  SELECT Country, "1990" as y1, [1990] AS y_value
  FROM [Tabelle1$A2:G5]
  UNION ALL
  SELECT Country, "1991" as y1, [1991] AS y_value
  FROM [Tabelle1$A2:G5]
  UNION ALL
  SELECT Country, "1992" as y1, [1992] AS y_value
  FROM [Tabelle1$A2:G5]
  ....
  

  Again, paste this into one cell, adjust the Excel-ranges to your Table1-Range, and read it into a string variable with cmd = YourSheet.Cells(1,2).

  Note: creating this SQL is obviously the messy part if you got 10+years. In that case, find a way to write the SQL semi-automatically, e.g. with formulas, and then concatenate them into one string.

• This gets us started. We now can create a QueryTable with the aforementioned properties. The final sub looks something like

  Option Explicit
  
  Sub CreateQT()
  
      With ThisWorkbook.Worksheets("sheet50")
  
  chkQT:
          If .QueryTables.Count > 0 Then .QueryTables(.QueryTables.Count).Delete: GoTo chkQT
  
          Dim con As String
          con = .range("con").Value
          Dim cmd As String
          cmd = .range("cmd").Value
  
          With .QueryTables.Add(Connection:=con, Destination:=.Cells(10, 1))
  
              .CommandType = xlCmdSql
              .CommandText = cmd
  
              .FieldNames = True
              .RowNumbers = False
              .FillAdjacentFormulas = False
              .PreserveFormatting = True
              .RefreshOnFileOpen = False
              .BackgroundQuery = False
              .SaveData = True
              .AdjustColumnWidth = True
              .PreserveColumnInfo = True
              .RefreshStyle = xlOverwriteCells
              .RefreshPeriod = 0
              .Refresh BackgroundQuery:=False
              .MaintainConnection = False
          End With
      End With
  
  End Sub
  

  This code contains some properties you might not need, however, since this isn't much of a performance issue, we can always get rid of them later.

Works for me, let me know if you need any help.

Hope this helps.