Turning 100 Data points into 6000 using VBA HELP!

[ytjjjtyj]

Hello,
So I have some data (in columns A and B). In between each cell, I need to add 60 points (done in column E and F). I do this by finding the difference between each cell for columns A and B and diving by 60 (done in columns I and J). So I am given columns A and B and I need to get columns E and F using VBA so it's quick and can be done in a second rather than hours.

You can see the pattern I am doing in columns E and F. I just don't know how I can do this in VBA. Please don't mind column E's pattern after the value 33- I got lazy and just went down but I would like it to always refer to its respective difference between each point/60 (Columns I and J).

24666

[ytjjjtyj]

#code

[Kenneth Hobs]

I am not sure that I understand your model. I am not sure why you used absolute references as the difference ratio is not the same for all data points.

This provides different results as such...

Sub Main()
Dim lr As Long
lr = Intersect(ActiveSheet.UsedRange, Range("A:D")).Rows.Count
[G1].Formula = "=A1"
[H1].Formula = "=B1"
Range("G2:G" & lr).Formula = "=G1+(A2-A1)/60"
Range("H2:H" & lr).Formula = "=H1+(B2-B1)/60"
End Sub

[p45cal]

See button in attached.
Data appears quickly, chart takes a second to update itself.
Code:
Sub blah()
x = Range("A1").CurrentRegion.Value
myFactor = 60
ReDim y(1 To (UBound(x) - 1) * myFactor + 1, 1 To 2)
k = 1
For i = 1 To UBound(x) - 1
step1 = (x(i + 1, 1) - x(i, 1)) / myFactor
step2 = (x(i + 1, 2) - x(i, 2)) / myFactor
For j = 0 To myFactor - 1
y(k, 1) = x(i, 1) + step1 * j
y(k, 2) = x(i, 2) + step2 * j
k = k + 1
Next j
Next i
'last Values:
y(k, 1) = x(i, 1)
y(k, 2) = x(i, 2)
Range("L1").Resize(UBound(y), 2).Value = y
End Sub

[Paul_Hossler]

I think I understand

Not the most efficient, but simplest and fast enough




Option Explicit


Sub AddMore()
Dim iIn As Long, iOut As Long, iAdd As Long
Dim dIncr1 As Double, dIncr2 As Double
Dim r As Range

Application.ScreenUpdating = False

With Worksheets("Sheet2")

Set r = .Cells(1, 1).CurrentRegion

.Cells(1, 5).CurrentRegion.ClearContents ' testing

iOut = 1

For iIn = 2 To .Cells(1, 1).CurrentRegion.Rows.Count

.Cells(iOut, 5).Value = .Cells(iIn - 1, 1).Value
.Cells(iOut, 6).Value = .Cells(iIn - 1, 2).Value
iOut = iOut + 1

dIncr1 = (.Cells(iIn, 1).Value - .Cells(iIn - 1, 1).Value) / 60#
dIncr2 = (.Cells(iIn, 2).Value - .Cells(iIn - 1, 2).Value) / 60#

For iAdd = 1 To 59
.Cells(iOut, 5).Value = .Cells(iOut - 1, 5).Value + dIncr1
.Cells(iOut, 6).Value = .Cells(iOut - 1, 6).Value + dIncr2
iOut = iOut + 1
Next iAdd
Next iIn

.Cells(iOut, 5).Value = .Cells(r.Rows.Count, 1).Value
.Cells(iOut, 6).Value = .Cells(r.Rows.Count, 2).Value
iOut = iOut + 1

End With
Application.ScreenUpdating = True
MsgBox "Done"

End Sub

[ytjjjtyj]

Thank you!

[ytjjjtyj]

Thank you Paul- this is definitely much faster!

[ytjjjtyj]

Thank you- this worked great! However, I do have a question for you. What if I wanted to add any random number between -5 to 5 only in the numbers that I added in between? How would I do that in your code?

[p45cal]

Not sure who you are asking but presuming you only want to add this to the right column then change:
y(k, 2) = x(i, 2) + step2 * j
to:
y(k, 2) = x(i, 2) + step2 * j + IIf(j <> 0, Rnd * 10 - 5, 0)

[Paul_Hossler]

.Cells(iOut, 6).Value = .Cells(iOut - 1, 6).Value + dIncr2 + (Int(10 * Rnd) - 5)



But I wouldn't do it that way if you want in introduce 'noise' into the data

I'd go with a percentage change (-5% to +5% for example)



For iAdd = 1 To 59
.Cells(iOut, 5).Value = .Cells(iOut - 1, 5).Value + dIncr1
.Cells(iOut, 6).Value = .Cells(iOut - 1, 6).Value + dIncr2
.Cells(iOut, 6).Value = (1 + 0.05 * (Rnd - 0.5)) * .Cells(iOut, 6).Value
iOut = iOut + 1
Next iAdd

[ytjjjtyj]

This worked! Thank you!

Not sure who you are asking but presuming you only want to add this to the right column then change:
y(k, 2) = x(i, 2) + step2 * j
to:
y(k, 2) = x(i, 2) + step2 * j + IIf(j <> 0, Rnd * 10 - 5, 0)

[ytjjjtyj]

Hi Paul,
Yes this is exactly what I was trying to say- I need noise in my data points to show some drifting. Thank you for showing me to use percentages.




.Cells(iOut, 6).Value = .Cells(iOut - 1, 6).Value + dIncr2 + (Int(10 * Rnd) - 5)



But I wouldn't do it that way if you want in introduce 'noise' into the data

I'd go with a percentage change (-5% to +5% for example)



For iAdd = 1 To 59
.Cells(iOut, 5).Value = .Cells(iOut - 1, 5).Value + dIncr1
.Cells(iOut, 6).Value = .Cells(iOut - 1, 6).Value + dIncr2
.Cells(iOut, 6).Value = (1 + 0.05 * (Rnd - 0.5)) * .Cells(iOut, 6).Value
iOut = iOut + 1
Next iAdd

[Paul_Hossler]

If you need normally distributed random noise between the lower and upper bounds, it gets a little more complicated, but do-able

[ytjjjtyj]

That is essentially what I am trying to do but putting that in VBA makes my life so much harder.

Do you happen to know any built in tools or some VBA code that does some statistical analysis stuff like R or Python's library called Panda?


If you need normally distributed random noise between the lower and upper bounds, it gets a little more complicated, but do-able

[Paul_Hossler]

Do you happen to know any built in tools or some VBA code that does some statistical analysis stuff like R or Python's library called Panda?

Just Excel -- it has a lot of stat tools

[ytjjjtyj]

Okay, thanks!

Just Excel -- it has a lot of stat tools

[Kenneth Hobs]

You can add an R add in. Search google for "excel r addin".

[Paul_Hossler]

I was thinking about adding noise -- it might be better to do it in two passes

Pass 1 - generate linear increment values
Pass 2 - add 'noise' to each of the Pass 1 values




Option Explicit
Sub AddMore()
Dim iIn As Long, iOut As Long, iAdd As Long, iOut2 As Long
Dim dIncr1 As Double, dIncr2 As Double
Dim r As Range

Application.ScreenUpdating = False

With Worksheets("Sheet2")

Set r = .Cells(1, 1).CurrentRegion

.Cells(1, 5).CurrentRegion.ClearContents ' testing

iOut = 1

For iIn = 2 To .Cells(1, 1).CurrentRegion.Rows.Count

.Cells(iOut, 5).Value = .Cells(iIn - 1, 1).Value
.Cells(iOut, 6).Value = .Cells(iIn - 1, 2).Value
iOut = iOut + 1

dIncr1 = (.Cells(iIn, 1).Value - .Cells(iIn - 1, 1).Value) / 60#
dIncr2 = (.Cells(iIn, 2).Value - .Cells(iIn - 1, 2).Value) / 60#

iOut2 = iOut 'remember start

For iAdd = 1 To 59
.Cells(iOut, 5).Value = .Cells(iOut - 1, 5).Value + dIncr1 ' Col E
.Cells(iOut, 6).Value = .Cells(iOut - 1, 6).Value + dIncr2 ' Col F
iOut = iOut + 1
Next iAdd

iOut = iOut2 ' restart iOut
For iAdd = 1 To 59
.Cells(iOut, 6).Value = (1 + 0.05 * (Rnd - 0.5)) * .Cells(iOut, 6).Value
iOut = iOut + 1
Next iAdd

Next iIn

.Cells(iOut, 5).Value = .Cells(r.Rows.Count, 1).Value
.Cells(iOut, 6).Value = .Cells(r.Rows.Count, 2).Value
iOut = iOut + 1

End With
Application.ScreenUpdating = True
MsgBox "Done"

End Sub

[ytjjjtyj]

Paul, this worked so well! You are so talented! Thank you! The other one was too much noise and disappearing my actual data into the noise also. I just tried this one and it was way more clear in defining where it is going up and down and putting noise between so my raw data is still in tact.

I'm sorry to ask, but can you explain what you did in your code that made it work so well and how this works?


I was thinking about adding noise -- it might be better to do it in two passes

Pass 1 - generate linear increment values
Pass 2 - add 'noise' to each of the Pass 1 values




Option Explicit
Sub AddMore()
Dim iIn As Long, iOut As Long, iAdd As Long, iOut2 As Long
Dim dIncr1 As Double, dIncr2 As Double
Dim r As Range

Application.ScreenUpdating = False

With Worksheets("Sheet2")

Set r = .Cells(1, 1).CurrentRegion

.Cells(1, 5).CurrentRegion.ClearContents ' testing

iOut = 1

For iIn = 2 To .Cells(1, 1).CurrentRegion.Rows.Count

.Cells(iOut, 5).Value = .Cells(iIn - 1, 1).Value
.Cells(iOut, 6).Value = .Cells(iIn - 1, 2).Value
iOut = iOut + 1

dIncr1 = (.Cells(iIn, 1).Value - .Cells(iIn - 1, 1).Value) / 60#
dIncr2 = (.Cells(iIn, 2).Value - .Cells(iIn - 1, 2).Value) / 60#

iOut2 = iOut 'remember start

For iAdd = 1 To 59
.Cells(iOut, 5).Value = .Cells(iOut - 1, 5).Value + dIncr1 ' Col E
.Cells(iOut, 6).Value = .Cells(iOut - 1, 6).Value + dIncr2 ' Col F
iOut = iOut + 1
Next iAdd

iOut = iOut2 ' restart iOut
For iAdd = 1 To 59
.Cells(iOut, 6).Value = (1 + 0.05 * (Rnd - 0.5)) * .Cells(iOut, 6).Value
iOut = iOut + 1
Next iAdd

Next iIn

.Cells(iOut, 5).Value = .Cells(r.Rows.Count, 1).Value
.Cells(iOut, 6).Value = .Cells(r.Rows.Count, 2).Value
iOut = iOut + 1

End With
Application.ScreenUpdating = True
MsgBox "Done"

End Sub

[ytjjjtyj]

Hi Kenneth, I tried searching for something that does this and there is nothing like that unless it is with a institution that has bought the feature. I found how to import and export data back and forth but that's not useful.



You can add an R add in. Search google for "excel r addin".

[Paul_Hossler]

Paul, this worked so well! You are so talented! Thank you! The other one was too much noise and disappearing my actual data into the noise also. I just tried this one and it was way more clear in defining where it is going up and down and putting noise between so my raw data is still in tact.

I'm sorry to ask, but can you explain what you did in your code that made it work so well and how this works?

The original version was calculating based on previously calculated number so the 'noise' kept building, i.e. noise on noise on noise on …


This version does it in two passes, calculate all 1/60 increments and then make each of the 59 'noisy'

[ytjjjtyj]

Hi Paul, I have multiple columns of named ranges that I want to pass this code into to get the new set. Do you know how I could do that? and have it create the new set in columns one after the other instead of clearing the contents?

[Paul_Hossler]

You can probably start with this

Using arrays would be faster, but I find it's easier to see what's going on by using the worksheet



Option Explicit

Sub AddMore()
Dim rowIn As Long, rowOut As Long, rowAdd As Long, rowOut2 As Long
Dim dIncr1 As Double, dIncr2 As Double
Dim r As Range
Dim colOut As Long, colIn As Long, colOutStart As Long



Application.ScreenUpdating = False

With Worksheets("Sheet1")

Set r = .Cells(1, 1).CurrentRegion

rowOut = 1

colOutStart = r.Columns.Count + 2

'Col A first
colIn = 1

For rowIn = 2 To r.Rows.Count

.Cells(rowOut, colOutStart).Value = .Cells(rowIn - 1, colIn).Value
rowOut = rowOut + 1

dIncr1 = (.Cells(rowIn, colIn).Value - .Cells(rowIn - 1, colIn).Value) / 60#

For rowAdd = 1 To 59
.Cells(rowOut, colOutStart).Value = .Cells(rowOut - 1, colOutStart).Value + dIncr1
rowOut = rowOut + 1
Next rowAdd
Next rowIn

.Cells(rowOut, colOutStart).Value = .Cells(r.Rows.Count, colIn).Value

'do remaining input columns
colOut = colOutStart

For colIn = 2 To r.Columns.Count

rowOut = 1
colOut = colOut + 1

For rowIn = 2 To .Cells(1, 1).CurrentRegion.Rows.Count

.Cells(rowOut, colOut).Value = .Cells(rowIn - 1, colIn).Value
rowOut = rowOut + 1

dIncr2 = (.Cells(rowIn, colIn).Value - .Cells(rowIn - 1, colIn).Value) / 60#

rowOut2 = rowOut 'remember start

For rowAdd = 1 To 59
.Cells(rowOut, colOut).Value = .Cells(rowOut - 1, colOut).Value + dIncr2
rowOut = rowOut + 1
Next rowAdd


rowOut = rowOut2
For rowAdd = 1 To 59
.Cells(rowOut, colOut).Value = (1 + 0.05 * (Rnd - 0.5)) * .Cells(rowOut, colOut).Value
rowOut = rowOut + 1
Next rowAdd

Next rowIn

.Cells(rowOut, colOut).Value = .Cells(r.Rows.Count, colIn).Value
Next colIn

End With

Application.ScreenUpdating = True
MsgBox "Done"

End Sub

[ytjjjtyj]

Finally got it working-thanks! Initially- my first row was titles so it was acting weird.