Expand Data Structure to One Record per Time Period

[sport099]

I have a giant spreadsheet that I inherited, and I would like to change thedata structure. I would like to have each record (row) correspond to one date; currently it is set up with a beginning and end time period. I thinkan example makes clear what I’m hoping to do. Does anyone have a suggestion as to a relatively efficient way to go about this? Any ideas would bemuch appreciated.—Dan

Name Location Begin End
A XX 1 3
A YY 4 6
A ZZ 7 7
B UU 3 5
B VV 6 7

Name Location Date
A XX 1
A XX 2
A XX 3
A YY 4
A YY 5
A YY 6
A ZZ 7
B UU 3
B UU 4
B UU 5
B VV 6
B VV 7

 

[joeu2004]

I have a giant spreadsheet that I inherited, and I would
like to change the data structure. I would like to have
each record (row) correspond to one date; currently it is
set up with a beginning and end time period. I think an
example makes clear what I’m hoping to do. Does anyone
have a suggestion as to a relatively efficient way to go
about this?

Name Location Begin End
A XX 1 3
A YY 4 6
A ZZ 7 7
B UU 3 5
B VV 6 7

Name Location Date
A XX 1
A XX 2
A XX 3
A YY 4
A YY 5
A YY 6
A ZZ 7
B UU 3
B UU 4
B UU 5
B VV 6
B VV 7

 

[joeu2004]

I have a giant spreadsheet that I inherited, and I would like
to change the data structure. I would like to have each record
(row) correspond to one date; currently it is set up with a
beginning and end time period. I think an example makes clear
what I’m hoping to do. Does anyone have a suggestion as to a
relatively efficient way to go about this?

Sorry about the previous content-less response. Clicked on the wrong
button. :-(

I think this is easiest to do with a macro, although an Excel solution might
be possible (TBD). The following macro assumes that the active worksheet
has the original data starting in A22. It creates a new worksheet with
reformatted data starting in A2:C2.

Do you need help entering and customizing the macro?

Would you prefer to select the original data (put the cursor in the
upper-left corner) and create the reformatted data in starting in the same
relative location on a new worksheet?


Sub doit()
Dim v As Variant
Dim nv As Long, r As Long, i As Long, j As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
v = Range("a2", Cells(2, "d").End(xlDown))
nv = UBound(v, 1)
Sheets.Add after:=ActiveSheet
r = 1
For i = 1 To nv
For j = v(i, 3) To v(i, 4)
r = r + 1
Cells(r, "a") = v(i, 1)
Cells(r, "b") = v(i, 2)
Cells(r, "c") = j
Next j
Next i
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
MsgBox "done"
End Sub


----- original message -----
I have a giant spreadsheet that I inherited, and I would like to change the
data structure. I would like to have each record (row) correspond to one
date; currently it is set up with a beginning and end time period. I think
an example makes clear what I’m hoping to do. Does anyone have a suggestion
as to a relatively efficient way to go about this? Any ideas would be much
appreciated.—Dan

Name Location Begin End
A XX 1 3
A YY 4 6
A ZZ 7 7
B UU 3 5
B VV 6 7

Name Location Date
A XX 1
A XX 2
A XX 3
A YY 4
A YY 5
A YY 6
A ZZ 7
B UU 3
B UU 4
B UU 5
B VV 6
B VV 7

 

[sport099]

joeu2004 - much apprectiated. Let me try and customize this to my spreadsheet. You might hear back from me if I can't get it to work.--Dan

 

[sport099]

The macro for the referenced problem worked great and was easily tweaked tofit my spreadsheet. I have another one from the same data set that I was hoping to be able to modify the macro for, but have had some difficulty getting the loops right. I would like to have each record (row) correspond to one name/agent relationship. My difficulty has mainly been caused due to the different possible number of name/agent relationships. Once again an example should help. Any further assistance would be great.--Dan

P.S. Relative to the previous macro, the equivalent of my column “d” had blanks so in one attempted modification I replaced
v = Range("a2", Cells(2, "d").End(xlDown))
with
v = Range("a2", Cells(2, "a").End(xlDown).End(xlRight))
which gave a runtime ‘1004’ error
Anyone have any thoughts on what I needed to do differently

Name Agent1 Agent2 Agent3
A X Y Z
B W
C V
D W Y
E Z S

Name Agent AgentNum
A X 1
A Y 2
A Z 3
B W 1
C V 1
D W 1
D Y 2
E Z 1
E S 2

 

[joeu2004]

The macro for the referenced problem worked great and was easily
tweaked to fit my spreadsheet. I have another one from the same
data set that I was hoping to be able to modify the macro for,
but have had some difficulty getting the loops right.

Name Agent1 Agent2 Agent3
A X Y Z
B W
C V
D W Y
E Z S

Name Agent AgentNum
A X 1
A Y 2
A Z 3
B W 1
C V 1
D W 1
D Y 2
E Z 1
E S 2

Try the following macro. It assumes the original columns are known and
fixed (A). If that is not the case, I suggest that you select all of the
original data (A26 in your example) and replace v=Range(...) with
v=Selection in the macro.

Option Explicit

Sub doit()
Dim v As Variant
Dim nr As Long, nc As Long, n As Long
Dim r As Long, i As Long, j As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
v = Range("a2:d" & Cells(2, "a").End(xlDown).Row)
nr = UBound(v, 1)
nc = UBound(v, 2)
Sheets.Add after:=ActiveSheet
r = 1
For i = 1 To nr
n = 0
For j = 2 To nc
If v(i, j) <> "" Then
r = r + 1
n = n + 1
Cells(r, "a") = v(i, 1)
Cells(r, "b") = v(i, j)
Cells(r, "c") = n
End If
Next j
Next i
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
MsgBox "done"
End Sub

 

[sport099]

Wow, thanks.

FWIW, what I tried that I couldn't get to work on my sample test data was:

Sub expanddata()
Dim v As Variant
Dim nv As Long, r As Long, i As Long, j As Long, n As Long, agents As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
v = Range("a2", "d6")
nv = UBound(v, 1)
Sheets.Add after:=ActiveSheet
r = 1
For i = 1 To nv
agents = Range(Cells(i, 1), Cells(i, 3)).Cells.SpecialCells(xlCellTypeConstants).Count
For j = 1 To scouts
r = r + 1
Cells(r, "a") = v(i, 1)
Cells(r, "b") = v(i, j + 1)
Cells(r, "c") = j
Next j
Next i
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
MsgBox "done"
End Sub