Urgent Help Needed "Re-orient data"

[barkiny]

In column A
There are companies (Company A, Company B....)
In column B
There are dates (01/01/2006 , 01/02/2006....)

I want to re-orient data so that
In column A the company set will be repeating assingned to each
date...

it will look like that

Company A 01/01/2006
Company B 01/01/2006
Company A 01/02/2006
Company B 01/02/2006

thanks in advance...


+-------------------------------------------------------------------+
|Filename: sheet1.zip |
|Download: http://www.excelforum.com/attachment.php?postid=4758 |
+-------------------------------------------------------------------+

 

[Bob Phillips]

Sub ReorientData()
Dim iLastRow As Long
Dim cDates As Long
Dim i As Long, j As Long
Dim nCalculation
Dim aryDates

With Application
.ScreenUpdating = False
nCalculation = .Calculation
.Calculation = xlCalculationManual
End With

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
cDates = Cells(Rows.Count, "B").End(xlUp).Row - 1
ReDim aryDates(1 To cDates)
For i = 1 To cDates
aryDates(i) = Cells(i + 1, "B").Value
Next i
For i = iLastRow To 2 Step -1
Rows(i + 1).Resize(cDates - 1).Insert
For j = 1 To cDates
Cells(i + j - 1, "B").Value = aryDates(j)
Next j
Cells(i, "A").Resize(cDates).Value = Cells(i, "A").Value
Next i

'reset status quo
With Application
.Calculation = nCalculation
.ScreenUpdating = True
End With

End Sub


--
HTH

Bob Phillips

(remove xxx from email address if mailing direct)

 

[barkiny]

thanks for the code
but i think it repeats companies
can you change the repeating items

Not like
Company 1 date1
Company 1 date2
Company 2 date1
Company 2 date2

but like that
Company 1 date1
Company 2 date1
Company 1 date2
Company 2 date2

and is it possible to run the macro in sheet2 so that it wont overwrite
the main values

thanks alot
regards

 

[Bob Phillips]

I think this is what you want

Sub ReorientData()
Dim cData As Long
Dim cDates As Long
Dim i As Long, j As Long
Dim nCalculation
Dim aryDates

With Application
.ScreenUpdating = False
nCalculation = .Calculation
.Calculation = xlCalculationManual
End With

cData = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row - 1
cDates = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row - 1
ReDim aryDates(1 To cDates)
For i = 1 To cDates
aryDates(i) = Sheet1.Cells(i + 1, "B").Value
Next i
Sheet1.Range("A1:B1").Copy Sheet2.Range("A1")
For i = 1 To cDates
Sheet1.Cells(2, "A").Resize(cData).Copy Sheet2.Cells(cData * (i - 1)
+ 2, "A")
Sheet2.Cells(cData * (i - 1) + 2, "B").Resize(cData).Value =
aryDates(i)
Next i

'reset status quo
With Application
.Calculation = nCalculation
.ScreenUpdating = True
End With

End Sub

--
HTH

Bob Phillips

(remove xxx from email address if mailing direct)

 

[barkiny]

yes, that's what i need

thank you very much

regard