I'm helping someone over in the .Functions group. It's a data extraction
problem.
Here's what we have:
...............header1.....header2.....header3.....Count
Data1.......date1.........date2........date3...........2
Data2.......date1.........date2........date3...........1
Data3........................date2........date3............0
Data4.......date1........date2.............................2
Data5.........................................date3............1
The count column is the numbers of dates that Data(n) meets a criteria, the
month number.
We need to create a list of Data(n) that repeats based on the number in the
Count column. Like this:
Data1
Data1
Data2
Data4
Data4
Data5
I can do this with a couple of helper formulas but it is a real PITA and is
the hardest part of solving this problem. We need this list output to a
different sheet.
Thanks!
Biff
--
Regards,
Tom Ogilvy
"T. Valko" <biffi...@comcast.net> wrote in message
news:u6jTs4E...@TK2MSFTNGP05.phx.gbl...
I'd use a VBA function to do this, something like what follows. Pass in with
absolute cell references the range that has your data names (your "Data1",
"Data2" range), and the range that contains the CountNumbers. Something
like
=FillOutFromValues($A$1:$A$5,$B$1:$B$5)
Array enter that formula in to a range containing at least SUM(CountNumbers)
rows. If the formula is entered in to more than SUM(CountNumbers) rows, the
last elements of the array are set to vbNullStrings and will show up as
blanks in the worksheet. If the formula is entered into less than
SUM(CountNumbers) rows, elements at the end of the array are not displayed.
Function FillOutFromValues(DataNameRange As Range, _
CountRange As Range) As Variant
Dim ResultArr() As Variant
Dim ResultRowCount As Long
Dim Ndx As Long
Dim CountNdx As Long
Dim ResultNdx As Long
If DataNameRange.Columns.Count > 1 Then
FillOutFromValues = CVErr(xlErrRef)
Exit Function
End If
If CountRange.Columns.Count > 1 Then
FillOutFromValues = CVErr(xlErrRef)
Exit Function
End If
If DataNameRange.Rows.Count <> CountRange.Rows.Count Then
FillOutFromValues = CVErr(xlErrRef)
Exit Function
End If
On Error Resume Next
If IsObject(Application.Caller) = False Then
FillOutFromValues = CVErr(xlErrRef)
Exit Function
End If
ResultRowCount = Application.WorksheetFunction.Max( _
Application.WorksheetFunction.Sum(CountRange), _
Application.Caller.Rows.Count)
ReDim ResultArr(1 To ResultRowCount)
ResultNdx = 0
For Ndx = 1 To DataNameRange.Rows.Count
For CountNdx = 1 To CountRange.Cells(Ndx, 1)
ResultNdx = ResultNdx + 1
ResultArr(ResultNdx) = DataNameRange.Cells(Ndx)
Next CountNdx
Next Ndx
For ResultNdx = ResultNdx + 1 To ResultRowCount
ResultArr(ResultNdx) = vbNullString
Next ResultNdx
FillOutFromValues = Application.Transpose(ResultArr)
End Function
--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)
"T. Valko" <biffi...@comcast.net> wrote in message
news:u6jTs4E...@TK2MSFTNGP05.phx.gbl...
Biff
"Tom Ogilvy" <twog...@msn.com> wrote in message
news:evxxOGF...@TK2MSFTNGP02.phx.gbl...
Thanks!
Biff
"Chip Pearson" <ch...@cpearson.com> wrote in message
news:%23wU6rcF...@TK2MSFTNGP05.phx.gbl...
Thanks guys!
Biff
"T. Valko" <biffi...@comcast.net> wrote in message
news:OOg63wFW...@TK2MSFTNGP04.phx.gbl...
sh.Range("A2:A65536").ClearContents
Biff
"Tom Ogilvy" <twog...@msn.com> wrote in message
news:evxxOGF...@TK2MSFTNGP02.phx.gbl...