I have a code which takes data from a PicoLog 1012 and records it into an excel spreadsheet. It is working well but currently it always records 12 channels of data. This will make it slow if a lot of data is required so I would like to allow users to enter a value in a cell to define the number of channels and then skip running unnecessary code based on this.
The important parts are:
Dim values() As Integer 'number of datapoints in the array. Equal to channels * number of datapoints required.
Dim numChannels As Integer
numChannels = Worksheets("Sheet1").Range("W5").value 'this allows the user to set the number of channels
Dim samplenum As Long
samplenum = Worksheets("Sheet1").Range("W3").value 'Reads number of samples desired per channel
nValues = samplenum * numChannels
'The code apparently requires one of these lines per channel.
channels(0) = 1
channels(1) = 2
channels(2) = 3
channels(3) = 4
channels(4) = 5
channels(5) = 6
channels(6) = 7
channels(7) = 8
channels(8) = 9
channels(9) = 10
channels(10) = 11
channels(11) = 12
ReDim values(12 * Worksheets("Sheet1").Range("W3").value) 'allow a variable data array
Dim sampleInterval As Long
Dim microsecs_for_block As Long
Dim testlength As Integer
testlength = Worksheets("Sheet1").Range("W4").value
microsecs_for_block = testlength * 1000000
status = pl1000SetInterval(handle, microsecs_for_block, nValues, channels(0), numChannels)
status = pl1000Run(handle, nValues, 0)
'If there is a more efficient way to do what follows then I would LOVE to hear it. Currently logging begins long after I activate the macro.
ready = 0
Do While ready = 0
status = pl1000Ready(handle, ready)
Loop
Cells(14, "P").value = "RECORDING COMPLETE" 'indicate readiness
' Get a block of W3 readings...
' we can call this routine repeatedly
' to get more blocks with the same settings
Dim triggerIndex As Long
Dim overflow As Integer
status = pl1000GetValues(handle, values(0), samplenum, overflow, triggerIndex)
' Copy the data into the spreadsheet
For i = 0 To samplenum - 1
1: Cells(i + 4, "A").value = adc_to_mv(values(numChannels * i + 0))
2: Cells(i + 4, "B").value = adc_to_mv(values(numChannels * i + 1))
3: Cells(i + 4, "C").value = adc_to_mv(values(numChannels * i + 2))
4: Cells(i + 4, "D").value = adc_to_mv(values(numChannels * i + 3))
5: Cells(i + 4, "E").value = adc_to_mv(values(numChannels * i + 4))
6: Cells(i + 4, "F").value = adc_to_mv(values(numChannels * i + 5))
7: Cells(i + 4, "G").value = adc_to_mv(values(numChannels * i + 6))
8: Cells(i + 4, "H").value = adc_to_mv(values(numChannels * i + 7))
9: Cells(i + 4, "I").value = adc_to_mv(values(numChannels * i + 8))
10: Cells(i + 4, "J").value = adc_to_mv(values(numChannels * i + 9))
11: Cells(i + 4, "K").value = adc_to_mv(values(numChannels * i + 10))
12: Cells(i + 4, "L").value = adc_to_mv(values(numChannels * i + 11))
Next i
My current idea is to write 12 different subs for this and call each one depending on the number of channels required but I am sure there must be an easier way?
Is there some sort of "skip" command which causes lines to be ignored?
IF numChannels = 2
Then skip 3,4,5,6,7,8,9,10,11,12
Else
IF numChannels = 3
Then skip 4,5,6,7,8,9,10,11,12
Else
IF'.... et cetera
I believe the code you are looking for is GoTo. You can have those if statements and if the if statement is triggered, it will "GoTo" where ever your tag has been placed
MSDN Example
Sub SkipLines()
Dim intSkipToLine as Integer
If intSkipToLine = 1 Then Goto Line1:
If intSkipToLine = 2 Then Goto Line2:
If intSkipToLine = 3 Then Goto Line3:
If intSkipToLine = 4 Then Goto Line4:
Line1:
' first line code
Line2:
' second line code
Line3:
' thrid line code
Line4:
' fourth line code
End Sub
You can see the final solution I came up with here
It is not a perfect solution for logging data with picolog but IMHO it is better than the proprietary software if you don't need huge datasets or real-time visualisation.
Pros:
Instantly usable by anyone with excel experience; no need to use
picolog’s interface
No need to convert data for processing into excel
Automatic graphing using excel’s interface
Scope for easy further development (multisheet handling, application-specific processing)
Cons:
No realtime visualisation of data
May struggle to handle logs with over 10,000 data points
Related
I'm writing a code that calculates the probability given a certain amount of successes. I'm having trouble writing a for loop such that I can categorize some events as failures and some as successes. I was able to do it for Case Is = 1, but I'm not thinking of any clever way to iterate the other cases in a way that would go through all combinations of successes and failures given an amount of successes that the user inputs.
I have made an attempt for Case=2, but can't think of a way to record the failures. In Case=1, I worked around it by using modulus.
Function CustomBinomial(MoveType, SuccessAmount) As Double
'Variables to record which events succeed and fail
Dim FirstEvent As Double
Dim SecondEvent As Double
Dim ThirdEvent As Double
Dim FourthEvent As Double
Dim FifthEvent As Double
Dim SixthEvent As Double
'Rows the probability values are in
ProbSuccessArray = Array(15, 19, 23, 27, 31, 35)
Select Case SuccessAmount
Case Is = 0
'Record 0 events as successful
Case Is = 1
For i = 0 To 5
'Record 1 event as successful
FirstEvent = ProbSuccessArray(i)
'Record 5 events as failures
SecondEvent = ProbSuccessArray((i + 1) Mod 6)
ThirdEvent = ProbSuccessArray((i + 2) Mod 6)
FourthEvent = ProbSuccessArray((i + 3) Mod 6)
FifthEvent = ProbSuccessArray((i + 4) Mod 6)
SixthEvent = ProbSuccessArray((i + 5) Mod 6)
CustomBinomial = CustomBinomial + Cells(FirstEvent, 3).Value * (1 - Cells(SecondEvent, 3).Value) _
* (1 - Cells(ThirdEvent, 3).Value) * (1 - Cells(FourthEvent, 3).Value) _
* (1 - Cells(FifthEvent, 3).Value) * (1 - Cells(SixthEvent, 3).Value)
Next i
Case Is = 2
For i = 0 To 5
For j = 1 To 5
'Record 2 events as successful
If i = j Then GoTo Continue
FirstEvent = ProbSuccessArray(i)
SecondEvent = ProbSuccessArray(j)
'Record 4 events as failures
'code here
'CustomBinomial = CustomBinomial + Successes * Failures
Continue:
Next j
Next i
Case Is = 3
'Record 3 events as successful
Case Is = 4
'Record 4 events as successful
Case Is = 5
'Record 5 events as successful
Case Is = 6
'Record 6 events as successful
End Select
I am experiencing a problem with the outputs from my loop. As the sub is running I can see that the results from the final IF statement are being overwritten by the results from the second one. My code is structured as follows:
for i = 1 to 5
for j = 1 to 50
for each events.value in eventArray
if events.value = arrayElem then
if cells(i,j).value = "x" then
type = "col1"
elseif cells(i,j).value = "y" then
date = "col2"
elseif cells(i,j).value = "z" then
num = "col3"
end if
count = count + 1
activeworkbook.worksheets("output").cells(count + 1, 1) = type
activeworkbook.worksheets("output").cells(count + 1, 2) = date
activeworkbook.worksheets("output").cells(count + 1, 3) = num
end if
next arrayElem
if cells(i,j).value = "a" then
name = "row1"
elseif cells(i,j).value = "b" then
size = "row2"
elseif cells(i,j).value = "c" then
height = "row3"
end if
activeworkbook.worksheets("output").cells(count + 2, 1) = name
activeworkbook.worksheets("output").cells(count + 2, 2) = size
activeworkbook.worksheets("output").cells(count + 2, 3) = height
next j
next i
Obviously these are dumby variables and results, but the overall structure is the same as the real code. I can see "name","size", and "height" being printed, but then they get replaced by "type", "date", and "num". How do I prevent this from happening? Each time a new event is found I need it to print its associated characteristics printed into a new row in the "output" sheet.
Consider the following simplified version of your code:
For i = 1 To 100
If x = y Then
rowNum = rowNum + 1
Cells(rowNum + 1, 1) = "A"
End If
Cells(rowNum + 2, 1) = "B"
Next
Each time through the loop you are writing out either one or two things (two if x = y is true, one if it isn't) but you are only incrementing the row number by zero or one (one if x = y is true, zero if it isn't). Even if you know that x will always equal y, you are still trying to write two rows of information out but only increasing the row counter by one.
Assuming you are not trying to replace the "B"s in my example with the "A"s from the next iteration through the loop, you should change the code to something like:
For i = 1 To 100
If x = y Then
rowNum = rowNum + 1
Cells(rowNum, 1) = "A"
End If
rowNum = rowNum + 1
Cells(rowNum, 1) = "B"
Next
I am trying to write a macro on MS Excel, which will enable me to create random samples and pick random values from those samples for each category in the data.
To be more specific, the data is at 2 levels: firm and year, where each row represents a firm-year-peer observation. For each firm i, at a given year j, we have number of actual peers.
What I want to do is assign to each firm, from the whole sample throughout many years, a random firm from the list of all available firms at that specific year. The trick is that the number of firms to be assigned should be identical to the number of actual peers that a firm has at that year. Also, the randomly assigned values should be different from the firm's actual peers, and of course, the firm itself.
i j k
1 2006 100
1 2006 105
1 2006 110
2 2006 113
2 2006 155
2 2006 200
2 2006 300
For example, Firm 1's actual peers in year 2006 are 100, 105 and 110. However, all possible firms available are 100, 105, 110, 113, 155, 200 and 300. This means that I have to select 3 (because Firm 1 has 3 actual peers) random fictional peers from the 4 firms that are not Firm 1's peer that year (i.e. 113, 155, 200 and 300). Applying the same procedure for Firm 2, I need to select 4 random firms that are not Firm 2's actual peers from all possible firms.
I hope this was clear.
I started trying this function out on MS Excel, but I am open to suggestions if you think other platforms would be more useful.
Your help would be very much appreciated!
Thanks!
Many thanks to everyone who has visited my post.
After some initial struggling, I have managed to figure out the code myself. I am posting it below for anyone who might need it.
Basically I used the randomisation code posted by this gentle soul, and enhanced it for my needs using couple of flags for each new firm and each new year. Hope it is clear for everyone.
Best
Sub Random_Sampling()
'
Dim PeerCount, FirmCount, YearCount As Long
Dim Focal_CIK, fiscalYear As Long
Const nItemsTotal As Long = 1532
Dim rngList As Range
Dim FirmYearRange As Range
Dim FirmStart, FirmStartRow, YearStartRow As Long
Dim ExistingPeers As Range
Dim idx() As Long
Dim varRandomItems() As Variant
Dim i, j, k, m, n As Long
Dim iCntr, jCntr As Long
Dim booIndexIsUnique As Boolean
Set rngList = Sheets("Sheet2").Range("A2").Resize(nItemsTotal, 1)
FirmCount = Cells(2, 10).Value
For k = 1 To FirmCount
FirmStart = Application.WorksheetFunction.Match(k, Columns("E"), 0)
Focal_CIK = Cells(FirmStart, 1).Value
YearCount = Cells(FirmStart, 7).Value
For m = 1 To YearCount
Set FirmYearRange = Range("H" & FirmStart & ":H200000")
YearStartRow = Application.WorksheetFunction.Match(m, FirmYearRange, 0) + FirmStart - 1
fiscalYear = Cells(YearStartRow, 3).Value
PeerCount = Cells(YearStartRow, 9).Value
Set ExistingPeers = Range(Cells(YearStartRow + PeerCount, 2), Cells(YearStartRow + PeerCount, 2))
ReDim idx(1 To PeerCount)
ReDim varRandomItems(1 To PeerCount)
For i = 1 To PeerCount
Do
booIndexIsUnique = True ' Innoncent until proven guilty
idx(i) = Int(nItemsTotal * Rnd + 1)
For j = 1 To i - 1
If idx(i) = idx(j) Then 'Is already picked
ElseIf idx(i) = Focal_CIK Then 'Is the firm itself
booIndexIsUnique = False 'If true, don't pick it
Exit For
End If
For n = 1 To PeerCount
If idx(i) = Cells(YearStartRow + n - 1, 2).Value Then 'Is one of the actual peers
booIndexIsUnique = False 'If true, don't pick it
Exit For
Exit For
End If
Next n
Next j
If booIndexIsUnique = True Then
Exit Do
End If
Loop
varRandomItems(i) = rngList.Cells(idx(i), 1)
Rows(YearStartRow + PeerCount).EntireRow.Insert
'The order of the columns are very important for the following lines
Cells(YearStartRow + PeerCount, 1) = Focal_CIK
Cells(YearStartRow + PeerCount, 2) = varRandomItems(i)
Cells(YearStartRow + PeerCount, 3) = fiscalYear
Cells(YearStartRow + PeerCount, 4) = "0"
Next i
Next m
Next k
End Sub
Please help , this is my first try to code something useful by VBA and I am self-learning now. And I got that above error . Please help
Sub Bezier()
Dim C As Double, k As Integer, ansx As Double, ansy As Double, t As Double, n As Integer
n = 3
For i = 0 To 100
t = i * 0.01
ansx = 0
ansy = 0
For k = 0 To n
C = (WorksheetFunction.Fact(n) / WorksheetFunction.Fact(k)) / WorksheetFunction.Fact(n - k)
ansx = ansx + Cells(k + 2, 1).Value * C * WorksheetFunction.Power(t, k) * WorksheetFunction.Power(1 - t, n - k)
ansy = ansy + Cells(k + 2, 2).Value * C * WorksheetFunction.Power(t, k) * WorksheetFunction.Power(1 - t, n - k)
Next
Cells(i + 2, 6).Value = ansx
Cells(i + 2, 7).Value = ansy
Next
End Sub
First of all, you should know, that some of functions, used on the worksheet, have limitations. So my point is avoid of using them in VBA, if it is not necessary.
For example, function POWER() returns error on attempt to raise a zero to zero. An alternative is to use 0 ^ 0 combination, which is exactly doing the same, but looks more simply and operates without such error. But also there is no embedded alternative in VBA to the FACT() function, so you can use it, or simply add your own function factor() - it's uppon your choise.
If you just have started learning VBA, I would recomend you to use Option Explicit. It will help you to find out, which variables are not defined, and sometimes to avoid errors related to variable names missprint.
Here is your code, fixed and a little bit optimized:
Option Explicit' It is an option that turns on check for every used variable to be defined before execution. If this option is not defined, your code below will find undefined variables and define them when they are used. Good practice is to use this option, because it helps you, for example to prevent missprinting errors in variable names.
Sub Bezier()
Dim C as Double , t As Double
Dim k As Long, n As Long, i As Long
n = 3
For i = 0 To 100
t = i * 0.01
Cells(i + 2, 6) = 0
Cells(i + 2, 7) = 0
For k = 0 To n
C = (WorksheetFunction.Fact(n) / WorksheetFunction.Fact(k)) / WorksheetFunction.Fact(n - k)
Cells(i + 2, 6) = Cells(i + 2, 6).Value + Cells(k + 2, 1).Value * C * (t ^ k) * ((1 - t) ^ (n - k))
Cells(i + 2, 7) = Cells(i + 2, 7).Value + Cells(k + 2, 2).Value * C * (t ^ k) * ((1 - t) ^ (n - k))
Next
Next
End Sub
UPDATE
Here are some examples of factorial calculations.
Public Function fnFact(number) ' a simple cycle example of Factorial function
Dim tmp As Long ' new temporary variable to keep the "number" variable unchanged
tmp = number
fnFact = number
While tmp > 1
tmp = tmp - 1
fnFact = fnFact * tmp
Wend
End Function
Public Function fnFactR(number) ' a simple example of recursive function for Factorial calculation
If number > 0 Then
fnFactR = fnFactR(number - 1) * number ' function calls itself to continue calculations
Else
fnFactR = 1 ' function returns {1} when calculations are over
End If
End Function
Sub Factor_test() 'RUN ME TO TEST ALL THE FACTORIAL FUNCTIONS
Dim number As Long
number = 170 ' change me to find Factorial for a different value
MsgBox "Cycle Factorial:" & vbNewLine & number & "!= " & fnFact(number)
MsgBox "WorksheetFunction Factorial:" & vbNewLine & number & "!= " & WorksheetFunction.Fact(number)
MsgBox "Recursive Factorial:" & vbNewLine & number & "!= " & fnFactR(number)
End Sub
All those functions are available to calculate Factorial only for numbers before 170 inclusively, because of large result value.
So for my PC the limitation for WorksheetFunction.Fact() function is also 170.
Let me know, if your PC has different limitation for this function, - it's quite interesting thing. :)
UPDATE2
It is recomended to use Long data type instead of Integer each type when integer (or whole number) variable is needed. Long is slightly faster, it has much wider limitations and costs no additional memory. Here are proof links:
1. MSDN:The Integer, Long, and Byte Data Types
2. ozgrid.com:Long Vs Integer
3. pcreview.co.uk:VBA code optimization - why using long instead of integer?
Thanks for #Ioannis and #chris neilsen for the information about Long data type and proof links!
Good luck in your further VBA actions!
I can't find a pow method on the WorksheetFunction object. There is a Power method though. Perhaps you meant that?
In VBA, I can easily pull in an sheet\range into an array, manipulate, then pass back to the sheet\range. I'm having trouble doing this in VB.Net though.
Here's my code.
Rng = .Range("a4", .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
Dim SheetArray(,) As Object = DirectCast(Rng.Value(Excel.XlRangeValueDataType.xlRangeValueDefault), Object(,))
For X As Integer = 0 To SheetArray.GetUpperBound(0)
If IsNothing(SheetArray(X, 0)) Then Exit For
SheetArray(X, 6) = SheetArray(X, 3)
SheetArray(X, 7) = CDbl(SheetArray(X, 3).ToString) - CDbl(SheetArray(X, 1).ToString) - _
CDbl(SheetArray(X, 7).ToString)
For Y As Integer = 0 To 3
SheetArray(X, Y * 2 + 1) = Math.Round(CDbl(SheetArray(X, Y * 2 + 1).ToString), 3)
Next
If Math.Abs(CDbl(SheetArray(X, 7).ToString)) > 0.1 Then _
.Range(.Cells(X + 1, 1), .Cells(X + 1, 8)).Font.Color = -16776961
Next
I'm getting an error on the first If IsNothing(SheetArray(X, 0)) Then Exit For
line. It is telling me index is out of bounds of the array. Any idea why? The SheetArray object contains the data, but I just am not sure how to get to it.
In the For you have to loop from 0 to Count - 1:
For X As Integer = 0 To SheetArray.GetUpperBound(0) - 1
'...
Next
That will fix your problem.