howiechiang
New Member
- Joined
- Jan 27, 2014
- Messages
- 12
<tbody> </tbody> |
<tbody>
</tbody>
The solution should come out to this:
Name | Category | Number |
Al | cat. 1 | #2 |
Al | cat. 3 | #2 |
Ben | cat. 1 | #1 |
Ben | cat. 2 | #2 |
Fred | cat. 4 | #1 |
<tbody>
</tbody>
<tbody> </tbody> |
Name | Category | Number |
Al | cat. 1 | #2 |
Al | cat. 3 | #2 |
Ben | cat. 1 | #1 |
Ben | cat. 2 | #2 |
Fred | cat. 4 | #1 |
A | B | C | D | E | F | G | H | |
1 | Category | cat. 1 | cat. 1 | cat. 2 | cat. 2 | cat. 3 | cat. 3 | cat. 4 |
2 | Number | #1 | #2 | #1 | #2 | #1 | #2 | #1 |
3 | Name | |||||||
4 | Al | x | x | |||||
5 | Ben | x | x | |||||
6 | Fred | x |
Dim oTarget As Range
Dim oXed As Range
Dim oCell As Range
Dim oDest As Range
Set oDest = ThisWorkbook.Worksheets("Sheet2").Range("A1")
Set oTarget = ActiveSheet.Range("B3:H6")
'Select only the cells in B3:H6 that contain an X
Set oXed = oTarget.SpecialCells(xlCellTypeConstants)
oDest.Value = "Name"
oDest.Offset(0, 1).Value = "Category"
oDest.Offset(0, 2).Value = "Number"
Set oDest = oDest.Offset(1, 0)
'Transpose the data starting in A2 of Sheet2
For Each oCell In oXed
oDest.Value = Cells(oCell.Row, 1).Value
oDest.Offset(0, 1).Value = Cells(1, oCell.Column).Value
oDest.Offset(0, 2).Value = Cells(2, oCell.Column).Value
Set oDest = oDest.Offset(1, 0)
Next oCell
End Sub
If a new X is put in, it should output the new data in an empty area on a new sheet.
what if the categories were merged? Since excel doesn't assign a value for all the merged cells, but only the top-left one. What would you do then?
Public Sub Unmerge()
Dim oCurrCell As Range
Dim oMergeArea As Range
Dim vSplit As Variant
Dim lCounter As Long
Set oMergeArea = ActiveSheet.Range("B1")
'Some properties of the merged area
Debug.Print oMergeArea.MergeArea.Address
Debug.Print oMergeArea.MergeArea.Cells.Count
Debug.Print oMergeArea.MergeArea.Cells(1).Value
Set oCurrCell = oMergeArea.MergeArea.Cells(1)
'Preserve the contents of the first cell of the merged area
vSplit = oMergeArea.MergeArea.Cells(1).Value
oMergeArea.MergeArea.Cells.ClearContents
oMergeArea.Unmerge
'Burst the string using " c" (<space> c)as the delimiter because there are also spaces preceding the numbers
vSplit = Split(vSplit, " c")
'Show the contents of the array. Note that the leading "c" is missing from all
'elements of the array except the first because it was used as part of the delimiter
For lCounter = LBound(vSplit) To UBound(vSplit)
Debug.Print vSplit(lCounter)
Next lCounter
'Replace the missing "c" starting at the second array element
For lCounter = LBound(vSplit) + 1 To UBound(vSplit)
vSplit(lCounter) = "c" & vSplit(lCounter)
Next lCounter
'Could leave cells merged and use array data (immediately above) to transpose "X" grid
'Dump the contents of the array again. Note that the missing leading "c" has been replaced
For lCounter = LBound(vSplit) To UBound(vSplit)
Debug.Print vSplit(lCounter)
Next lCounter
'Place the contents of the array back into the unmerged cells
Debug.Print oCurrCell.Address
For lCounter = LBound(vSplit) To UBound(vSplit)
oCurrCell.Value = vSplit(lCounter)
Set oCurrCell = oCurrCell.Offset(0, 1)
Next lCounter
'Run transpose "X" code as though the cells were never merged
End Sub