Question

I have worked on this problem for my entire day and can’t solve it.

The input data consists of several data blocks with the same number of rows and columns. Each data block has its name in the first line within the block. Besides, they are further separated by a blank row.

block1
name score value
 a     2     3
 b     3     5
 c     1     6

block2
name score value
 a     4     6
 b     7     8
 c     2     6

block3
name score value
 a     5     4
 b     7     8
 c     2     9

The desired output is to extract the name and value column of each block, and then parallel them in columns. Like this:

value  block1  block2 block3
 a       3     6      4
 b       5     8      8
 c       6     6      9

Thanks for your help!

UPDATE
Thanks for your answer, Tony, and others!
I just have another requirement. It is possible that some row in some tables are missing. In other words, as you mentioned previously, the row number may vary. Is it possible to fill in the corresponding cell in these tables with NA? i.e. the new input is like:

block1
name score value
a     2     3
c     1     6

block2
name score value
a     4     6
b     7     8
c     2     6

block3
name score value
a     5     4
b     7     8

The desired output now is like this:

value  block1  block2 block3
a       3       6      4
b       NA      8      8
c       6       6      NA

UPDATE on Jul.3 (If it’s inappropriate to make the question too long, I will move this part and make it a new question)

 block1
name score value
 a     2     3
 b     3     5
 c     1     6

block2
name score value
 a     4     6
 b     7     8
 c     2     6

block3
name score value
 a     5     4
 b     7     8
 c     2     9

How can I pull both the value and its corresponding score and put them into one cell? Like this: The code indicates that the value is put into an dynamic array. Then the .range is assigned to this array. My first thought is to construct another array to store the value of the “score” column. Then loop through each element in both array, and concatenate them together. However, it seems that VBA does allow me to loop through the array, since its dimension is not defined. I tried REDIM, but it did not work.

value  block1   block2    block3
 a       3(2)     6(4)      4(5)
 b       5(3)     8(7)      8(7)
 c       6(1)     6(2)      9(2)

Answer 1

First answer – introduction to issues and request for clarification

This is not a solution – you do not give enough information for a solution – but introduces the issues and possible techniques. Warning: I have typed this into NotePad; no guarantees that there are no syntax errors.

You say each table is the same size although I assume not 3×3. But if they were 3×3, could I say table 1 starts in row 1, table 2 starts in row 7 and table N starts in 6(N-1)+1? That is, can you calculate the position of each table or do you need to search?

If you need to search, the following might help:

Dim ColSrcLast as Long
Dim RowSrcCrnt As Long

RowSrcCrnt = 1      ' Assumed start of Table 1

With Worksheets("xxxx")
  ColSrcLast = .Cells(RowCrnt,Columns.Count).End(xlToLeft).Column
End With

ColSrcLast = .Cells(RowCrnt,Columns.Count).End(xlToLeft).Column is the VBA equivalent of placing the cursor in the last column of row RowCrnt+1 and then clicking Control+Left. This is probably the easiest way of finding the last used column in table 1.

Control+ArrowKey moves the cursor in the indicated direction and:

• if the current cell is blank, stops at the first non-blank cell,
• if the current cell is non-blank and so is the next, stops at the last non-blank cells before a blank cell,
• if the current cell is non-blank but the next cell is blank, stops at the next non-blank cell,
• if no cell meets the above criteria, stops at the end of range.

Experiment and the above will become clearer.

If the number of blank lines between tables might vary, I think the following will be the easiest method of locating each table:

Dim Found As Boolean
Dim RowSrcCrnt As Long
Dim RowSrcLast As Long
Dim RowSrcTableTitle As Long
Dim RowSrcTableLast As Long

With Worksheets("xxxx")
  ' Find last used row of worksheet
  RowSrcLast = .Cells(Rows.Count,"A").End(xlUp).Row
End With

RowSrcCrnt = 1

Do While RowSrcCrnt <= RowSrcLast
  With Worksheets("xxxx")
    Found = False
    Do While RowSrcCrnt <= RowSrcLast
      If .Cells(RowSrcCrnt,"A").Value = "" then
        ' Have found start of next (first) table
        RowSrcTableTitle = RowSrcCrnt
        Found = True
        Exit Do
      End If 
      RowSrcCrnt = RowSrcCrnt+1
    Loop
    If Not Found Then
      ' No more tables
      Exit Do
    End If
    RowSrcTableLast = .Cells(RowSrcTableTitle,"A").End(xlDown).Row
  End With

  ' Process table RowSrcTableTitle to RowSrcTableLast

  RowSrcCrnt = RowSrcTableLast+1
Loop

Within the above loop we have: Process table RowSrcTableTitle to RowSrcTableLast.

Is the Name column always column “A”? Is the Value column always the last column? If not, you will have to search across the header row for the column names.

Is every table in the same sequence? If not, you will have to sort them. Does every table contain every row? If not, your code for combining the tables will have to allow for this.

I hope the above gets you started. Come back if you have specific questions.

Second answer – Response to clarification

I created a test worksheet Jia Source which looks like this:

You say that the tables are all the same size. In this situation, the following code outputs to the Immediate Window the dimensions of each table. The output from this code is:

Table A1:C6
Table A8:C13
Table A15:C20

For your tables you will need to change the values of constants TableHeight and TableWidth. You will also have to change “Jia Source” to the name of your source worksheet.

Option Explicit
Sub ExtractValue()

  Dim ColSrcLeft As Long
  Dim ColSrcRight As Long
  Dim RowSrcTitle As Long   ' First row or table
  Dim RowSrcHeader As Long  ' Header row of table
  Dim RowSrcEnd As Long     ' Last row of table

  Const TableHeight As Long = 4
  Const TableWidth As Long = 3

  RowSrcTitle = 1
  Do While True
    With Worksheets("Jia Source")
      If .Cells(RowSrcTitle, "A").Value = "" Then
        Exit Do
      End If
      RowSrcHeader = RowSrcTitle + 1
      RowSrcEnd = RowSrcHeader + TableHeight
      ColSrcLeft = 1
      ColSrcRight = ColSrcLeft + TableWidth - 1
      Debug.Print "Table " & colNumToCode(ColSrcLeft) & RowSrcTitle & ":" & _
                  colNumToCode(ColSrcRight) & RowSrcEnd
    End With

    ' Code to handle table goes here.

    RowSrcTitle = RowSrcEnd + 2

  Loop

End Sub
Function colNumToCode(ByVal colNum As Integer) As String

  ' Convert Excel column number to column identifier or code
  ' Last updated 3 Feb 12.  Adapted to handle three character codes.

  Dim code As String
  Dim partNum As Integer

  If colNum = 0 Then
    colNumToCode = "0"
  Else
    code = ""
    Do While colNum > 0
      partNum = (colNum - 1) Mod 26
      code = Chr(65 + partNum) & code
      colNum = (colNum - partNum - 1) \ 26
    Loop
    colNumToCode = code
  End If

End Function

I have left the code that shows how to search for the tables if they vary in size. If the above code does not produce the correct results for your worksheet, you may need to merge the two routines.

The following assumes RowSrcTitle, RowSrcHeader, RowSrcLast, ColSrcLeft and ColSrcRight are correct. It is the code from ExtractValue() plus the code to copy the data to the destination sheet which I have named “Jia Destination”. Its output is:

Have a play. Come back with questions if necessary.

Sub ExtractValue2()

  Dim ColDestCrnt As Long
  Dim ColSrcCrnt As Long
  Dim ColSrcLeft As Long
  Dim ColSrcRight As Long
  Dim Found As Boolean
  Dim RowDestBottom As Long
  Dim RowDestTop As Long
  Dim RowSrcTitle As Long   ' First row or table
  Dim RowSrcHeader As Long  ' Header row of table
  Dim RowSrcEnd As Long     ' Last row of table
  Dim TableTitle As String
  Dim CellArray() As Variant

  Const TableHeight As Long = 4
  Const TableWidth As Long = 3

  RowSrcTitle = 1
  ColDestCrnt = 1
  RowDestTop = 1
  RowDestBottom = RowDestTop + TableHeight

  Do While True
    With Worksheets("Jia Source")
      If .Cells(RowSrcTitle, "A").Value = "" Then
        Exit Do
      End If
      RowSrcHeader = RowSrcTitle + 1
      RowSrcEnd = RowSrcHeader + TableHeight
      ColSrcLeft = 1
      ColSrcRight = ColSrcLeft + TableWidth - 1

    End With

    If ColDestCrnt = 1 Then
      ' Column 1, the list of names, has not been output.
      ' This assumes all tables have the same rows in the same
      ' sequence

      With Worksheets("Jia Source")
        ' This statement loads all the values in a range to an array in a
        ' single statements.  Ask if you want more detail on what I am doing.
        ' Load name column for this table
        CellArray = .Range(.Cells(RowSrcHeader, ColSrcLeft), _
                           .Cells(RowSrcEnd, ColSrcLeft)).Value
      End With
      With Worksheets("Jia Destination")
        ' Clear destination sheet
        .Cells.EntireRow.Delete
        ' Write array containing name column to destination sheet
        .Range(.Cells(RowDestTop, 1), _
                 .Cells(RowDestBottom, 1)).Value = CellArray
      End With
      ColDestCrnt = ColDestCrnt + 1
    End If

    With Worksheets("Jia Source")
      ' Find Value column.
      Found = False
      For ColSrcCrnt = ColSrcLeft + 1 To ColSrcRight
        If LCase(.Cells(RowSrcHeader, ColSrcCrnt).Value) = "value" Then
          Found = True
          Exit For
        End If
      Next
    End With
    ' If Found is False, the table has no value column and is ignored
    If Found Then
      With Worksheets("Jia Source")
        ' Extract title of title
        TableTitle = .Cells(RowSrcTitle, ColSrcLeft).Value
        ' Load name column (excluding header) for this table
          CellArray = .Range(.Cells(RowSrcHeader + 1, ColSrcCrnt), _
                             .Cells(RowSrcEnd, ColSrcCrnt)).Value
      End With
      With Worksheets("Jia Destination")
        ' Copy title
        .Cells(1, ColDestCrnt).Value = TableTitle
        ' Write array containing name column to destination sheet
        .Range(.Cells(RowDestTop + 1, ColDestCrnt), _
               .Cells(RowDestBottom, ColDestCrnt)).Value = CellArray
      End With
      ColDestCrnt = ColDestCrnt + 1
    End If

    RowSrcTitle = RowSrcEnd + 2

  Loop

End Sub