Excel 2007 Formula - Collapse cells and its data - excel

Question

I'm currently using excel 2010 and have some data I'm trying to transform so to speak and output the results into sheet 2. I'm not sure where to start and was hoping for some guidance.
The image below is only a sample set of data. The actual spreadsheet consists of 92 rows and 78 columns. The first three columns are name and address and the rest are very similar to what is shown in the image. Some cells have a value, a zero, or blank. The rows in red is what I would like to accomplish.

Answer 1

Here is a solution using VBA.
It assumes that your existing sheet is named "Sheet1", and the new sheet exists and is named "Sheet2".
Option Explicit
Sub CollapseData()
Dim RowNbr As Long
Dim SrcColNbr As Long
Dim DestColNbr As Long
Dim MaxRowNbr As Long
Dim PeriodNbr As Long
Dim MaxPeriodNbr As Long
Dim SrcSheetName As String
Dim DestSheetName As String
Dim SrcSheet As Worksheet
Dim DestSheet As Worksheet
SrcSheetName = "Sheet1"
DestSheetName = "Sheet2"
Set SrcSheet = ThisWorkbook.Worksheets(SrcSheetName)
Set DestSheet = ThisWorkbook.Worksheets(DestSheetName)
' Determine last row number in use
MaxRowNbr = SrcSheet.Cells(Rows.Count, 1).End(xlUp).Row
' Copy name, addr1, and addr2 headings
For DestColNbr = 1 To 3
Call CopyCell(SrcSheet.Cells(1, DestColNbr), DestSheet.Cells(1, DestColNbr))
Next DestColNbr
' Determine number of period columns in use
MaxPeriodNbr = SrcSheet.Cells(1, Columns.Count).End(xlToLeft).Column - 3
' Generate date headings
DestColNbr = 4
For PeriodNbr = 1 To MaxPeriodNbr
DestSheet.Cells(1, DestColNbr) = "date" & Format(PeriodNbr, "##0")
DestSheet.Cells(1, DestColNbr + 1) = "amount" & Format(PeriodNbr, "##0")
DestColNbr = DestColNbr + 2
Next PeriodNbr
' Copy data from Sheet1 to Sheet2
For RowNbr = 2 To MaxRowNbr
' Copy name and address
For DestColNbr = 1 To 3
Call CopyCell(SrcSheet.Cells(RowNbr, DestColNbr), DestSheet.Cells(RowNbr, DestColNbr))
Next DestColNbr
DestColNbr = 4
For SrcColNbr = 4 To MaxPeriodNbr + 3
If SrcSheet.Cells(RowNbr, SrcColNbr) <> 0 Then
' Copy date from Sheet1 to Sheet2
Call CopyCell(SrcSheet.Cells(1, SrcColNbr), DestSheet.Cells(RowNbr, DestColNbr))
' Copy amount from Sheet1 to Sheet2
Call CopyCell(SrcSheet.Cells(RowNbr, SrcColNbr), DestSheet.Cells(RowNbr, DestColNbr + 1))
DestColNbr = DestColNbr + 2
End If
Next SrcColNbr
Next RowNbr
End Sub
Private Sub CopyCell(FromCell As Range, ToCell As Range)
FromCell.Copy
ToCell.PasteSpecial xlPasteValues
ToCell.PasteSpecial xlPasteFormats
End Sub

Answer 2

Here is how you can do it for the example you have shown. It should be simple to replicate the formulas for the whole set of data you have.
To get the first date that has an amount greater than zero, i am doing an array multiplication of the amounts array > 0 and the dates array. then i invert this array (1/array). AGGREGATE function gives you the largest value after ignoring the erros(#div0). Inverting again gives you the first date that has an amount greater than 0.
for the next date, i include one more criteria by checking if the date array has date greater than the date previously calculated, thus giving me the next date.
The formula for amounts are basically HLOOKUPs for the date that was retrieved.
for date 1
=1/AGGREGATE(14,6,1/((D2:I2>0)*D1:I1),1)
for amount 1
=HLOOKUP(D6,$D$1:$I$2,2,FALSE)
for date 2
=1/AGGREGATE(14,6,1/(($D$2:$I$2>0)*($D$1:$I$1>D6)*$D$1:$I$1),1)
for amount 2
=HLOOKUP(F6,$D$1:$I$2,2,FALSE)
for date 3
=1/AGGREGATE(14,6,1/(($D$2:$I$2>0)*($D$1:$I$1>F6)*$D$1:$I$1),1)
for amount 3
=HLOOKUP(H6,$D$1:$I$2,2,FALSE)