I have a big Excel sheet with data taken from the sensors from one windfarm.
It is in one column, one below the other, just a clean numbers, integer (example 1435). Those columns represent data from every 15 minutes.
I need to get the data from it and transform it to 10 min data.
My idea was to divide it by 3 (get 5 min data) and just add two of those.
But I need the formula in excel which does that in the other column.
So takes the first column
divide it by 3,
put it in the column next to it,
copy it in 2 more rows below
then repeat the procedure but with the other value in the 15 min data, below the first one.
I hope it makes sense,
much appreciated for any assistance
Just create some simple loops.
Sub tenmindata()
Dim lastRow As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
lastRow = Range("A" & Rows.Count).End(xlUp).Row
j = 3
For i = 3 To lastRow
For k = 1 To 3
Cells(j, 7) = Cells(i, 3).Value / 3
j = j + 1
Next k
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Not sure if I got your question right but try this:
=A1/3*2
Post that in the column next to your data and doubleclick the small black dot:
https://abload.de/img/excelbwbzz.png
Related
I'm trying to transfer information from a large matrix into a different report and this code works when I go step by step but it gets stuck in an infinite loop when I let it run without a break. Hoping to get some help if possible!
more context: Im trying to seek the information in a matrix in a different work sheet, copy information in the corresponding rows and columns, and then paste back into the original sheet with the referenced cell it is seeking
For k = 2 To 600
mpn = inbox.Cells(k, 3).value
If Not IsEmpty(mpn) = True Then
i = 1
j = 1
For j = 8 To 50
For i = 23 To 1000
mpnsearch = wshmatrix.Cells(i, j).value
If mpnsearch = mpn Then
color = wshmatrix.Cells(9, j).value
mpncolor = Right(color, 1)
inbox.Cells(k, 5).value = mpncolor
End If
Next i
Next j
End If
Next k
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
End Sub
If I understand your code correctly, you have a column of values in index, and you need to search each of these mpn in a 2D matrix wshmatrix. The return value mpncolor is in the same column but in the 9th line, above your search matrix.
If you had formatted this as a lookup table (all possible mpn values in column 1, all mpncolors in column 2), this could be solved without VBA, with VLOOKUP().
You can build this search table in VBA, if it is reasonably static.
If it changes frequently, you can use a Collection object:
Dim lookuptbl as New Collection
For j = 8 To 50
For i = 23 To 1000
lookuptbl.Add item := Right(wshmatrix.Cells(9, j).value, 1), _
key := CStr(wshmatrix.Cells(i, j).value)
Next
Next
For k = 2 To 600
mpn = inbox.Cells(k, 3).value
inbox.Cells(k, 5).value = lookuptbl.Item(CStr(mpn))
Next
I did not test it right now, but I think you can get the idea.
I ran into a problem when I try to add the first 10 even numbers in a column regardless of the number of inputs someone has entered into said column.
The issue occurs when there are less than 10 inputs (in my case 7) and I have tried to break the loop if there are no more numbers after the last one but it doesn't seem to work as it crashes Excel; most probably because it loops infinitely.
The original code was fine until I entered below 10 even numbers. When I did it would loop infinitely and crash so I inputted a forceful break in the code (hence the Count=999) but it does not seem to work
Sub TenPosInt()
Dim Total As Integer, size As Integer, myRange As range
Dim Count As Integer
Count = 1
Set myRange = range("W:W")
size = WorksheetFunction.CountA(myRange)
While Count <= 10
If IsEmpty(Cells(Count, "W")) Then
Count = 999
End If
If Cells(Count, "W").Value Mod 2 = 0 Then
Total = Total + Cells(Count, "W").Value
Count = Count + 1
End If
Wend
MsgBox Total
End Sub
My Inputs are currently 2,4,6,5,2,4,6,8,1,3,5 so it does not meet the 10 even integers, however I still want it to run regardless (hence the Count=999 line). The correct return should be 32.
A Do-While/Until loop is recommended instead of While-Wend (see this).*
Here I use a separate counter for row and the number of even values (and stole David's idea of combining the two conditions in the Do line).
Sub TenPosInt()
Dim Total As Long, r As Long, Count As Long
r = 1
Do Until Count = 10 Or Cells(r, "W") = vbNullString
If Cells(r, "W").Value Mod 2 = 0 Then
Total = Total + Cells(r, "W").Value
Count = Count + 1
End If
r = r + 1
Loop
MsgBox Total & " (" & Count & " even numbers)"
End Sub
*Actually I would be more inclined to use one of the other gent's answers, but I have tried to stick as close to yours as possible. (Also a good idea to check a cell is numeric before checking for even-ness.)
Just for fun - here is an approach that uses a For...Next loop, allows for non-numeric entries in Column W, and handles the possibility of blank rows between entries.
Sub TenPosInt()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "W").End(xlUp).Row
Dim i As Long
For i = 1 To lastRow
If Not IsEmpty(Cells(i, "W")) Then
If IsNumeric(Cells(i, "W")) Then
If Cells(i, "W").Value Mod 2 = 0 Then
Dim counter As Long
counter = counter + 1
Dim total As Long
total = total + Cells(i, "W").Value
If counter = 10 Then Exit For
End If
End If
End If
Next
MsgBox total
End Sub
Why not use a standard for loop across a range? this would give more specific inputs for the subroutine.
Description of what is occuring below has been commented out to allow for copy/pasting more easily.
'Define your range (you use columns("W"), but narrow that)... assuming you start in row 2 (assumes row 1 is headers), move to the last row, of the same columns:
lr = cells(rows.count,"W").end(xlup).row
'so you know the last row, loop through the rows:
for i = 2 to lr
'Now you will be doing your assessment for each cell in column "W"
if isnumeric(cells(i,"W").value) AND cells(i,"W").value mod 2 = 0 then
s = s + cells(i,"W").value
counter = counter + 1
if counter = 10 then exit for
end if
'Do that for each i, so close the loop
next i
'You now have determined a total of 10 items in the range and have added your items. Print it:
debug.print s
Edit1: got a comment to not break-up the code in an explanatory fashion, so I have added ' to comment out my explanations in an effort to make my coding portion copy/pasteable as a lump.
I have two excel sheets, one cumulative (year-to-date) and one periodic (quarterly). I am trying to check for potential entry errors.
Simplified ytd table:
ID Q1/18 Q2/18 Q3/18 Q4/18 Q1/19 Q2/19 ...
1 6 12 20 28 10 20
2 5 11 18 26 10 20
3 5 11 18 26 10 20
Simplified quarterly table:
ID Q1/18 Q2/18 Q3/18 Q4/18 Q1/19 Q2/19 ...
1 6 6 8 8 10 10
2 5 6 7 8 10 10
3 5 6 7 8 10 10
In the above example there are no entry errors.
I am trying to create a third sheet that would look something like this
ID Q1/18 Q2/18 Q3/18 Q4/18 Q1/19 Q2/19 ...
1 T T T T T
2 T T T T T
3 T T T T T
I initially tried using a formula like this:
=IF('YTD'!C2-'YTD LC'!B2-'QTR'!B2=0,T,F)
I don't particularly like this because the formula will not apply in the first quarter. This also assumes that my data in both sheets are ordered in the same way. Whilst I believe it to be true in all cases, I would rather have something like an index-match to confirm.
I tried working on a VBA solution based on other solutions I found here but made less progress than via the formulas:
Sub Compare()
lrow = Cells (Rows.Count, 1).End(xlUp).Row
lcol = Cells(1, Columns.Count).End(xltoLeft).Column
Sheets.Add
ActiveSheet.Name = "Temp Sheet"
For i = 2 To lrow
For j = 3 To lcol
valytd = Worksheets("YTD").Cells(i,j).Value
valytd = Worksheets("YTD").Cells(i,j).Value
If valytd = valytd Then
Worksheets("Temp").Cells(i,j).Value = "T"
Else:
Worksheets("Temp").Cells(i,j).Value = "F"
Worksheets("Temp").Cells(i,j).Interior.Color Index = 40
End If
Next j
Next i
End Sub
In my opinion the easiest way is to:
Create a sheet & copy paste row 1 + Column 1 like image below (Title & IDs)
Use Sum Product to get your answers
Formula:
=IF(SUMPRODUCT((Sheet1!$B$1:$G$1=Sheet3!$B$1)*(Sheet1!$A$2:$A$4=Sheet3!A2)*(Sheet1!$B$2:$G$4))=SUMPRODUCT((Sheet2!$B$1:$G$1=Sheet3!$B$1)*(Sheet2!$A$2:$A$4=Sheet3!A2)*(Sheet2!$B$2:$G$4)),"T","F")
Formula Notes:
Keep fix the range with Quarters using double $$ -> Sheet1!$B$1:$G$1
keep fix the range with IDs using double $$ -> Sheet1!$A$2:$A$4
Keep fix the range with values -> Sheet1!$B$2:$G$
Keep fix column header -> =Sheet3!$B$1
Leave variable rows number -> =Sheet3!A2
Images:
This should do the trick, the code is all commented:
Option Explicit
Sub Compare()
Dim arrYTD As Variant, arrQuarterly As Variant, arrResult As Variant
Dim Compare As Scripting.Dictionary 'You need Microsoft Scripting Runtime for this to work
Dim i As Long, j As Integer, x As Integer
With Application
.EnableEvents = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
.ScreenUpdating = False
End With
With ThisWorkbook
arrYTD = .Sheets("Name of YTD sheet").UsedRange.Value 'this will get everything on that sheet
arrQuarterly = .Sheets("Name of Quarterly sheet").UsedRange.Value 'this will get everything on that sheet
End With
ReDim arrResult(1 To UBound(arrYTD), 1 To UBound(arrYTD, 2)) 'resize the final array with the same size of YTD
Set Compare = New Scripting.Dictionary
'Here we fill the dictionary with the ID's position on the arrQuarterly array
For i = 2 To UBound(arrQuarterly) '2 because 1 is headers
If Not Compare.Exists(arrQuarterly(i, 1)) Then 'this is an error handle if you have duplicated ID's
Compare.Add arrQuarterly(i, 1), i 'now we know the position of that ID on the table
Else
'Your handle if there was a duplicated ID
End If
Next i
'Let's fill the headers on the result array
For i = 1 To UBound(arrYTD, 2)
arrResult(1, i) = arrYTD(1, i)
Next i
'Now let's compare both tables assuming the columns are the same on both tables (same position)
For i = 1 To UBound(arrYTD)
arrResult(i, 1) = arrYTD(i, 1) 'This is the ID
For j = 2 To UBound(arrYTD, 2)
x = Compare(arrYTD(i, 1)) 'this way we get the position on the quarterly array for that ID
If arrYTD(i, j) = arrQuarterly(x, j) Then 'compare if they have the same value on both sides
arrResult(i, j) = "T"
Else
arrResult(i, j) = "F"
End If
Next j
Next i
With ThisWorkbook.Sheets("Name of the result sheet") 'paste the array to it's sheet
.Range("A1", .Cells(UBound(arrResult), UBound(arrResult, 2))).Value = arrResult
End With
End Sub
I'm trying to write a simple script that compares and flags similar transactions (rows) and pastes them at the bottom of the sheet. The transactions which are to be flagged should meet the following criteria.
The $amount in the transactions is greater than 4000 or less than -4000 (column 11)
The two transactions being compared have the same part number (column 3)
Two transactions with similar dollar amounts (between 90-110% of each other) and opposite in number sign
Sub checktrans()
Dim newLastRow, rowcount As Long
Dim row, row2, amountcol, partnumcolcol As Integer
amountcol = 16
partnumcol = 3
rowcount = 27307
newLastRow = 37309
For row = 1 To rowcount
For row2 = 1 To rowcount
If Cells(row, amountcol) > 4000 Or Cells(row, amountcol) < -4000 Then
If row <> row2 Then
If Cells(row, partnumcol) = Cells(row2, partnumcol) Then
If Abs(Cells(row, amountcol)) > 0.9 * Abs(Cells(row2, amountcol)) And Abs(Cells(row, amountcol)) < 1.1 * Abs(Cells(row2, amountcol)) Then
If (Cells(row, amountcol) < 0 And Cells(row2, amountcol) > 0) Or (Cells(row, amountcol) > 0 And Cells(row2, amountcol) < 0) Then
ActiveSheet.Rows(row).Copy
ActiveSheet.Rows(newLastRow).PasteSpecial xlPasteAll
newLastRow = newLastRow + 1
ActiveSheet.Rows(row2).Copy
ActiveSheet.Rows(newLastRow).PasteSpecial xlPasteAll
newLastRow = newLastRow + 1
End If
End If
End If
End If
End If
Next row2
Next row
End Sub
I wrote the code above, and it seems to work for a low number of rows (below 500), but when the number of rows exceeds 27000 it goes into a never ending loop that keeps pasting new rows onto the sheet. It also posts each couple of transactions twice, which I understand is flaw in the logic which I have to work out as well.
P.S I am a giant noob when it comes to this, haven't programmed much before, and I'm just learning now to make my life easier.
First thing you can do is to start second loop from the point where first loop is currently. Like For row2 = row + 1 to rowcount. You checked previous records already. This will also fix problem with duplicates and you can delete If row <> row2.
Second, is to use Application.ScreenUpdating = False at the beginning of the macro and Application.ScreenUpdating = True at the end. This turns off screen updating while your macro is running and can be a huge improvement in performance.
At the end you can join all Ifs into one using And, however I don't know if this will improve performance.
How I can generate 5000 records in 2 columns of random numbers between 1 and 100 that being unique.
For example:
A B
----------------
1 98
1 23
37 98
6 56
93 18
. .
. .
. .
thanks
Excel formulas do not perform loops until a condition has been met. Any 'loop' or array processing must have a defined number of cycles. Further, RAND and RANDBETWEEN are volatile formulas that will recalculate anytime the workbook goes through a calculation cycle.
In VBA this would look like the following.
Sub Random_2500_x_2()
Dim rw As Long
For rw = 1 To 2500
Cells(rw, 1) = Int((100 - 1 + 1) * Rnd + 1)
Cells(rw, 2) = Int((100 - 1 + 1) * Rnd + 1)
Do Until Cells(rw, 2).Value <> Cells(rw, 1).Value
Cells(rw, 2) = Int((100 - 1 + 1) * Rnd + 1)
Loop
Next rw
End Sub
Here is a simple-minded approach using formulae. Whether it would be appropriate would depend on context.
First in the Formulas tab set calculation options to 'Manual'.
Put the following formula in a2:-
=RANDBETWEEN(1,100)
B is going to be a helper column. Put the following in B2:-
=RANDBETWEEN(1,99)
Column C is the second result that you want. Put the following in C2:-
=IF(B2<A2,B2,B2+1)
Pull the formulae down as required.
Each time you press 'Calculate Now', you will get a fresh set of random numbers.
However if you really need unique rows (every row to be different) you'd need a different approach - could generate a set of 4-digit numbers, split them into first and last pairs of digits and filter out ones where first and second were equal.
Generate the 4-digit number in A2:-
=RANDBETWEEN(1,9998)
Take the first two-digit number plus one in B2:-
=INT(A2/100)+1
Take the second 2-digit number plus one in C2:-
=MOD(A2,100)+1
Check for invalid numbers in D2:-
=OR(ISNUMBER(MATCH(A2,A$1:A1,0)),B2=C2)
Set up a running total of valid numbers in E2:-
=COUNTIF(D2:D$2,FALSE)
Here's how the second approach would look with checking for duplicate rows as well as duplicate numbers within a row. Note that you'd have to generate about 3,000 rows to get 2,500 distinct rows:-
First run this tiny macro:
Sub dural()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
k = 1
For i = 1 To 100
For j = 1 To 100
Cells(k, 1) = i
Cells(k, 2) = j
Cells(k, 3).Formula = "=rand()"
k = k + 1
Next j
Next i
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = True
End Sub
Then sort cols A,B,C by column C.Then pick the first 5000 rows.
EDIT#1:
To remove cases in which the value in column A is the same as the value in column B use this macro instead:
Sub dural()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
k = 1
For i = 1 To 100
For j = 1 To 100
If i <> j Then
Cells(k, 1) = i
Cells(k, 2) = j
Cells(k, 3).Formula = "=rand()"
k = k + 1
End If
Next j
Next i
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = True
End Sub