Reputation: 11
I have data that is output into 4 channels, one channel a second (channel 1 = 1st second, channel 2 = 2nd second, etc). So there are 4 columns for time and 4 for the associated data, which outputs into excel format.
I have created a simple for loop to collate the 4 columns of data into one, for each parameter. There are 124 parameters, and 5000 - 15000 data points long.
My current for loop is taking about 16 seconds per loop, which means it will take about 33 minutes per run to collate the data. I am no expert with coding or VBA by any stretch, so please forgive the bad format, etc.. just wondering if anyone here may have suggestions for improving the speed of this for loop. The slowest part seems to be the 'i' for loop, removing the 'k' for loop it is still 16 seconds or more.
The code is below:
Sub Create_CombinedData()
'
' Create_CombinedData Macro
'
Sheets("Sheet2").Select
graphrange = Application.WorksheetFunction.CountA(ActiveSheet.Columns(1))
j = 0
m = 497
n = 498
o = 0
For k = 1 To 124
For i = 2 To graphrange
Cells(i + j, m).Value = Cells(2 * i - 2, o + 249).Value
Cells(i + j, n).Value = Cells(2 * i - 2, o + 250).Value
Cells(1 + i + j, m).Value = Cells(2 * i - 2, o + 373).Value
Cells(1 + i + j, n).Value = Cells(2 * i - 2, o + 374).Value
Cells(2 + i + j, m).Value = Cells(2 * i - 2, o + 1).Value
Cells(2 + i + j, n).Value = Cells(2 * i - 2, o + 2).Value
Cells(3 + i + j, m).Value = Cells(2 * i - 2, o + 125).Value
Cells(3 + i + j, n).Value = Cells(2 * i - 2, o + 126).Value
j = j + 3
Next i
m = m + 2
n = n + 2
o = o + 2
l = 2
j = 0
Next k
End Sub
Upvotes: 0
Views: 216
Reputation: 11
Thanks to Paul Bica, here is the final code that works.
I had to play around with the array, split it into input and output data. "arr" loads the data that is to be combined, and "arr 2" is where that combined data is outputted. The whole process is split in two, top half of data and bottom half of data - otherwise, I was running out of memory.
I couldn't quite figure out the last row / last column bit to make it work, so I brute forced it with different numbers until it worked. I am sure there is a more logical way, but it does what it needs to do for my application.
Hope that helps.
Public Sub CreateCombinedData2()
Dim ws As Worksheet, lr As Long, lc As Long, col1 As Long, col2 As Long
Dim rId As Long, cr As Long, rr As Long, fr As Long, arr As Variant, arr2 As Variant, k As Long
Dim half As Long, fCol As Long
arr = Empty
arr2 = Emtpy
Sheets("Sheet3").Cells.ClearContents
Set ws = ThisWorkbook.Worksheets("Sheet2")
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Sheet1").ChartObjects.Delete 'this clears previous plots
Application.DisplayAlerts = True
On Error GoTo 0
lr = Application.WorksheetFunction.CountA(ws.Columns(1)) * 2 'last row
lc = Application.WorksheetFunction.CountA(ws.Rows(2)) + 300 'last col
half = lr \ 2
col1 = 497: col2 = 498
arr = ws.Range(ws.Cells(2, 1), ws.Cells(half, lc)) 'Top half rows
arr2 = ws.Range(ws.Cells(2, lc), ws.Cells(half, lc * 2))
For k = 1 To 62
Sheets("Sheet3").Select
Cells(1, col1).Value = ws.Cells(1, fCol + 2)
For cr = 2 To half * 0.25
rr = cr + rId
fr = 2 * cr - 2
arr2(rr + 0, col1) = arr(fr, fCol + 1): arr2(rr + 0, col2) = arr(fr, fCol + 2)
arr2(rr + 1, col1) = arr(fr, fCol + 125): arr2(rr + 1, col2) = arr(fr, fCol + 126)
arr2(rr + 2, col1) = arr(fr, fCol + 249): arr2(rr + 2, col2) = arr(fr, fCol + 250)
arr2(rr + 3, col1) = arr(fr, fCol + 373): arr2(rr + 3, col2) = arr(fr, fCol + 374)
rId = rId + 3
Next cr
col1 = col1 + 2: col2 = col2 + 2
fCol = fCol + 2
rId = 0
Next k
Sheets("Sheet3").Select
Range(Cells(2, 1), Cells(half, lc)) = arr2
col1 = 497
col2 = 498
rId = 0
fCol = 0
rr = 0
fr = 0
arr = Empty
arr2 = Emtpy
arr = ws.Range(ws.Cells(2, 1), ws.Cells(half, lc)) 'Bottom half rows
arr2 = ws.Range(ws.Cells(2, lc), ws.Cells(lr, lc * 2))
For k = 1 To 62
For cr = half * 0.25 To half * 0.5
rr = cr + rId - half * 0.25 + 1
fr = 2 * cr - 2
arr2(rr + 0, col1) = arr(fr, fCol + 1): arr2(rr + 0, col2) = arr(fr, fCol + 2)
arr2(rr + 1, col1) = arr(fr, fCol + 125): arr2(rr + 1, col2) = arr(fr, fCol + 126)
arr2(rr + 2, col1) = arr(fr, fCol + 249): arr2(rr + 2, col2) = arr(fr, fCol + 250)
arr2(rr + 3, col1) = arr(fr, fCol + 373): arr2(rr + 3, col2) = arr(fr, fCol + 374)
rId = rId + 3
Next cr
col1 = col1 + 2: col2 = col2 + 2
fCol = fCol + 2
rId = 0
Next k
Sheets("Sheet3").Select
Range(Cells(half + 1, 1), Cells(lr, lc)) = arr2
Wend
End Sub
Upvotes: 1
Reputation: 10705
Code below is the initial Sub converted to use an array (untested). It assumes all data is on Sheet2
I'm not sure is if the last column is determined properly:
.
Option Explicit
Public Sub CreateCombinedData1()
Dim ws As Worksheet, lr As Long, lc As Long, col1 As Long, col2 As Long
Dim rId As Long, cr As Long, rr As Long, fr As Long, arr As Variant, k As Long
Dim half As Long, fCol As Long
Set ws = ThisWorkbook.Worksheets("Sheet2") 'or ActiveSheet
lr = Application.WorksheetFunction.CountA(ws.Columns(1)) 'last row
lc = Application.WorksheetFunction.CountA(ws.Rows(2)) 'last col
half = lr \ 2
col1 = 497
col2 = 498
arr = ws.Range(ws.Cells(2, 1), ws.Cells(half, lc)) 'Top half rows
For k = 1 To 124
For cr = 2 To half
rr = cr + rId
fr = 2 * cr - 2
arr(rr + 0, col1) = arr(fr, fCol + 249): arr(rr + 0, col2) = arr(fr, fCol + 250)
arr(rr + 1, col1) = arr(fr, fCol + 373): arr(rr + 1, col2) = arr(fr, fCol + 374)
arr(rr + 2, col1) = arr(fr, fCol + 1): arr(rr + 2, col2) = arr(fr, fCol + 2)
arr(rr + 3, col1) = arr(fr, fCol + 125): arr(rr + 3, col2) = arr(fr, fCol + 126)
rId = rId + 3
Next cr
col1 = col1 + 2
col2 = col2 + 2
fCol = fCol + 2
rId = 0
Next k
ws.Range(ws.Cells(2, 1), ws.Cells(half, lc)) = arr
col1 = 497
col2 = 498
rId = 0
fCol = 0
rr = 0
fr = 0
arr = Empty
arr = ws.Range(ws.Cells(half + 1, 1), ws.Cells(lr, lc)) 'Bottom half rows
For k = 1 To 124
For cr = half + 1 To lr
rr = cr + rId
fr = 2 * cr - 2
arr(rr + 0, col1) = arr(fr, fCol + 249): arr(rr + 0, col2) = arr(fr, fCol + 250)
arr(rr + 1, col1) = arr(fr, fCol + 373): arr(rr + 1, col2) = arr(fr, fCol + 374)
arr(rr + 2, col1) = arr(fr, fCol + 1): arr(rr + 2, col2) = arr(fr, fCol + 2)
arr(rr + 3, col1) = arr(fr, fCol + 125): arr(rr + 3, col2) = arr(fr, fCol + 126)
rId = rId + 3
Next cr
col1 = col1 + 2
col2 = col2 + 2
fCol = fCol + 2
rId = 0
Next k
ws.Range(ws.Cells(half + 1, 1), ws.Cells(lr, lc)) = arr
End Sub
Upvotes: 0