Copy contents from array to two other arrays....not sure what to do

[DHolcombe]

Hi. I have the following code (also enclosing a file.......use code in module 2 not module 1).

What i am trying to do: I have to plot a graph and i have to create the front end of the data so that the plot looks correct. This is why i am doing what i am doing......now what am i trying to do exactly is this.

i have a list of dates in an array. However, i need to put those dates into cells of my worksheet such that i have the following:

date1 A
B
C
date2 A
B
C

etc....

So i created this for loop to do exactly what i want.......the problem is its slow. So i thought i could instead create two new arrays, fill those arrays with the right stuff then paste contents of the array into sheet......i was told doing it like this was faster.

So i need an array that will have the date1, empty, empty,date2,empty,empty.....etc
Need another array that will have A,B,C,A,B,C,A,B,C,.....etc

I am able to get the data "looking" like i want by pasting directlyl into the worksheet but again its kinda slow when i have my big file open.......






Here is my code: I could not paste file here so her eis the code. Note: In col C of sheet1 i have dates in rows 2 through 13 from Jan 1 2011 to Dec 1 2011.





'***********************************************************************
'***********************************************************************
' Returns the character equivalent of a col num
'***********************************************************************
'***********************************************************************
Function alphacol(numcol As Integer)
If numcol > 0 And numcol < 257 Then
If numcol > 26 Then
colchar = Chr(64 + Int((numcol - 1) / 26))
colchar = colchar & Chr(65 + ((numcol - 1) Mod 26))
Else: colchar = Chr(65 + ((numcol - 1) Mod 26))
End If
End If
alphacol = colchar
End Function

Sub Macro1()
Dim sht_array As Variant
Dim strt_unit_data_col As Integer


Portfolio_Filename = ThisWorkbook.Name

Set ws = Workbooks(Portfolio_Filename).Worksheets("Sheet1")

strt_unit_data_col = 3

sht_array = ws.Range(alphacol(strt_unit_data_col) & "2", ws.Cells(Rows.Count, alphacol(strt_unit_data_col)).End(xlUp))

For x = 1 To UBound(sht_array)
ws.Cells((3 * x - 1), strt_unit_data_col + 1).Value = sht_array(x, 1)
ws.Cells((3 * x - 1), strt_unit_data_col + 2).Value = "Overall"
ws.Cells((3 * x), strt_unit_data_col + 2).Value = "QBD"
ws.Cells((3 * x + 1), strt_unit_data_col + 2).Value = "QVC"
Next x

End Sub

 

[DHolcombe]

Here is what i came up with........seems to work.


Portfolio_Filename = ThisWorkbook.Name

Set ws = Workbooks(Portfolio_Filename).Worksheets("Sheet1")

strt_unit_data_col = 3

sht_array = ws.Range(alphacol(strt_unit_data_col) & "2", ws.Cells(Rows.Count, alphacol(strt_unit_data_col)).End(xlUp))

'MsgBox (UBound(sht_array))

strt_unit_data_col2 = 1
sht_array2 = ws.Range(alphacol(strt_unit_data_col2 + 1) & "2", ws.Cells(3 * UBound(sht_array) + 1, alphacol(strt_unit_data_col2 + 1)))


strt_unit_data_col2 = 1
sht_array3 = ws.Range(alphacol(strt_unit_data_col2 + 1) & "2", ws.Cells(3 * UBound(sht_array) + 2, alphacol(strt_unit_data_col2 + 1)))


'MsgBox (UBound(sht_array3))

For x = 1 To UBound(sht_array)

sht_array2(3 * x - 1, 1) = sht_array(x, 1)
'MsgBox (3 * x - 1)
'
'MsgBox (sht_array2(3 * x - 1, 1))
sht_array3((3 * x - 1), 1) = "Overall"
sht_array3((3 * x), 1) = "QBD"
sht_array3((3 * x + 1), 1) = "QVC"
Next x



ws.[d1].Resize(UBound(sht_array2), 1) = sht_array2
ws.[e1].Resize(UBound(sht_array3), 1) = sht_array3