Creating a record for generated numbers in VBA - excel

I'm building an Excel sheet to help me with teaching.
My objective is a sheet to create two random numbers, calculate their arithmetic means and geometric means, and compare them. This part I have finished.
I created a macro and two functions that generates random numbers, then input the numbers to the desired cells:
Sheets("Sheet1").Range("L1").Value = NewRandom()
Sheets("Sheet1").Range("M1").Value = NewRandom2()
I created a button to execute the macro.
How could I make a record of what I have been generating, in designated area U7:V200, on the same sheet?
My aim: The first time I click the button, two generated numbers will be recorded on U7 and V7, respectively. The second time I click, two generated numbers will be recorded on U8 and V8, and so on.

The subroutine below will find the next empty row based on the "U" column of your sheet.
XLROW signifies the row in which you want to begin your search for an empty row.
Once the empty row is found, the two random values that you have passed to the subroutine will be entered into the first available empty row.
Make sure to change "Sheet1" to the name, if you have one, of the sheet that you are using in excel.
Public Sub NEXTEMPTY(VAL1 As Integer, VAL2 As Integer)
Dim XLROW As Integer
XLROW = 7
Do Until Sheet1.Range("U" & XLROW) = ""
XLROW = XLROW + 1
Loop
Sheet1.Range("U" & XLROW).Value = VAL1
Sheet1.Range("V" & XLROW).Value = VAL2
End Sub
Then you can just call the sub anywhere you'd like using:
Call NEXTEMPTY(RANDOM1, RANDOM2)
EDIT: You can also use this in the Do Until. This is more preferable.
Do Until IsEmpty(Sheet1.Range("U" & XLROW))

This is just a matter of finding the last row and pasting to it...
dim lr as long
lr = cells(rows.count,"U").end(xlup).row
cells(lr+1,"U").value = randomnumber1
cells(lr+1,"V").value = randomnumber2
Assumes you are always having U/V paired together, so only need 1 last row

Related

Get row with first 10 empty cells in excel spreadsheet

I am creating a vb.net application to update an excel spreadsheet.
I access the excel file using Imports Microsoft.Office.Interop.
So far I can add data to the desired worksheet using hardcoded cell co-ordinates, for example :
sheet.Cells(3, 3) = mystring
I need to loop through each row to find the first row where each of the first 10 cells (A-J) contain no data so I can update those cells. I need to do it this way as columns K onwards may contain other data so I cant check for whole blank rows.
My attempt has started off just checking cell A in each row to begin with, trying to identify a blank/empty cell. If it worked I was thinking about using a for loop inside the do while loop too move along the cells in the row.
Using the following code I get a message box stating "System.__ComObject".
Dim rowcount As Integer = 0
Dim emptyrowfound As Boolean = False
Do While emptyrowfound = False
rowcount += 1
MessageBox.Show(sheet.Cells(rowcount, 1).ToString) ' attempt to view cell contents for testing purposes
If sheet.Cells(rowcount, 1).ToString = "" Then ' attempt to test if cell is blank/empty
emptyrowfound = True
End If
Loop
Once working I intend to apply cell updates like :
sheet.Cells(rowcount, 3) = mystring
...
Can anyone suggest a better way of checking and getting the row number?
First, I would do my check by starting in the 10th column and working left for each row using a Range object. You can use Range.End(xlleft) to check all cells to the left of the specified cell - it will stop at the first nonempty cell, which you are expecting to be in the first column. You should then be able to use the Range.Row property to return the row number of the cell you desire.
Below is a code snippet I dug up, hope it is useful.
For iRow = 1 To 5
For iCol = 1 To 10
IsFist10ColEmpty = True
Cellval = oxlsworksheet.Range(oxlsworksheet.Cells(iRow, iCol).Address(RowAbsolute:=False, ColumnAbsolute:=False)).Value
If Len(Cellval) > 0 Then
IsFist10ColEmpty = False
Exit For
End If
Next
If IsFist10ColEmpty = True Then
MessageBox.Show(iRow & "Rows's First 10 cols are empty.")
End If
Next
working line for you is :
Cellval = oxlsworksheet.Range(oxlsworksheet.Cells(iRow, iCol).Address(RowAbsolute:=False, ColumnAbsolute:=False)).Value
Originally I got answer from Anders Lindahl
link is :
Anders Lindahl's original answer

How can I calculate the sum of the numbers of two columns for only a portion of the rows?

Say I have an Excel sheet with 10,000 rows and two columns. All 20,000 cells are filled with numbers and there is no missing data. I want to have a third column, the values of which are the sum of Column A and Column B. For example, C70 = A70 + B70, and C82 = A82 + 82, and the like.
The only problem is I want to do it for only a portion of the rows, say from row 125 to row 8954. I don't care about the rest of the values. And I don't want to do it by dragging the grid using the mouse. Is that possible?
If you have access to SEQUENCE() (Currently only available to Office 365 Insiders) then yes it is possible:
=INDEX(A:A,SEQUENCE(1000,,ROW(),1))+INDEX(B:B,SEQUENCE(1000,,ROW(),1))
Where 1000 is the number of rows desired. Place the formula in the first cell desired and it will automatically fill the rest.
I believe you need some logic about what is going on, related to the start and end row.
You can use an if-statement or sumifs() for this... will do an if-statement so i can specify not meeting the requirements as null.
With Start row as 2 and end row as 4 (see image), you can use this formula, and drag it down to the bottom of all columns:
=IF(AND(ROW(A2)<=F$2,ROW(A2)>=E$2),SUM(A2:B2),"")
Notice in the image that C5 has no value; this is due to the conditions of the if-statement being false.
Another idea, a simple macro that will do what you want by asking the user what the starting and end row is.
Sub test()
Dim startrow As Integer 'variable to hold first row
Dim endrow As Integer 'variable to hold last row
startrow = InputBox("Enter the start row")
endrow = InputBox("Enter the end row")
'loops through you desired range calculating what you want
Dim i As Integer
For i = startrow To endrow
Cells(i, 4).Value = Cells(i, 1).Value + Cells(i, 2).Value
Next
End Sub
Just change the values to suit your needs in what cells you want to add up and where you want the sum to go.

Excel VBA cross-sheet referencing

This is my first attempt at using VB in excel so bear with me.
I have a column of names where there are multiple duplicates of each, then in another column is the hours that each person as spent on a particular project. What my function does is goes down the list of names and each time it finds a match with $name it adds the corresponding hours up then returns the total.
Now this works when the table I'm getting the input from is on the same sheet as I'm using the Function, however I want to have the results on a separate sheet from the table. I believe its an issue with how its referencing the cell in line 10 but I'm not sure how to resolve this.
Function Hours(start as Range, finish As Range, name As String) As Double
Hours = 0#
RowStart = start.Row
RowFinish = finish.Row
NameColumn = start.Column
HourColumn = finish.Column
For i = RowStart To RowFinish
If Cells(i, NameColumn) = name Then Hours = Hours + Cells(i, HourColumn).Value
Next i
End Function
As David pointed out, pass in the range from the other sheet and manipulate the data from there. See following UDF.
Function GetTotalHours(EmpNameR As Range, EmpName As String) As Double
Dim CellR As Range, HoursTotal As Double
HoursTotal = 0
For Each CellR In EmpNameR
If CellR.Value = EmpName Then
HoursTotal = HoursTotal + CellR.Offset(0, 1).Value
End If
Next
GetTotalHours = HoursTotal
End Function
In action:
Sheet1:
Sheet2:
Hope this helps.
you can access any sheet by index of by name, I always prefer by name.
Sheets("my_output_sheet_name").cells(row#, col#).value = total_hours
WHen you do "Cells(i, NameColumn)" it is assuming the current/active sheet. Doing what i said above, allows you to access any sheet regardless of which one is active.
So assuming you want to also list the names in the results sheet, right after the for loop, you could do:
Sheets("results").Cells(resultRow, NameColumn).value = name
Sheets("results").Cells(resultRow, HourColumn).value = Hours
where obviously you have a sheet called "results" and you will increment "resultsRow" after every name.
I realize this does not answer your VBA question, but there is a much easier way to do this within Excel without VBA. Try:
=SUMPRODUCT((NameColumn="Name")*Hours)
The forumula works by testing each name in NameColumn (a named range- you can replace it with the address of your data) with "Name" which results in an array of TRUE and FALSE values. When that array is multiplied by Hours range (also a named range), TRUE values are converted to 1s, and FALSE values are 0s. Then SUMPRODUCT() adds the result.

excel if cell includes XYZ copy to new sheet

I have a downloaded bank statement on SHEET1 (ALL).
I have several widgets running along the side one of which
=SUMIF(C:C,H3,D:D)
Searches the Descriptions for the value in H3 (EG: * WAGES *) and totals up the corresponding value in D.
I now need to expand that so that it copies the entire ROW onto a new Spreadsheet.
I'd also like, if possible, to start with an input box so I can search for multiple things at once.
Various code that I have seen / tried will only work for exact values in Row C. But with the bank statement its never the same twice and I'd like it to wildcard the search if possible.
Thanks for your time.
Kind Regards
Alex Nicol
I have recently written VBA code just like this. Where I use the word payments, you can use the word Wages and include your wildcards like so:
a.Cells(b.Row, 16).Value LIKE "*Wages*"
Sub ShortTerm()
Dim a As Range, b As Range
Dim i As Long
Dim j As Long
Dim p As Long
Dim value1 As Variant
i = 4 'the start row for pasting
Set a = ThisWorkbook.Sheets("Payments").UsedRange
For Each b In a.Rows
'in the next line change 16 to reflect the column where WAGES is found
If a.Cells(b.Row, 16).Value = "Short Term" Then
For j = 1 to 16
value1 = a.Cells(b.Row, j).Value
ThisWorkbook.Sheets("DestinationSheet").Cells(i, j).Value = value1
Next
i = i + 1
End If
Next
End Sub
Obviously I am only copying 16 columns and so if that is all you want, this should work. If you need more, make that loop larger. There is probably a way to copy the whole row, but I had originally only wanted specific cells and I had wanted them reorganized which is why I did it the way I did.
See the post on my blog here:
http://automatic-office.com/?p=355

Removing duplicates from large sheet

I want to remove rows based on duplicate cells in a column from large sheet, without leaving duplicate sample (like "Remove Duplicates" Excel command does). So if I have:
1
2
2
3
I want, as a result:
1
3
This can be accomplished with conditional formatting, then filtering or sorting duplicates and deleting filtered data, but the process is very slow for large sheet.
Conditional formatting takes second, but just clicking on filter takes around 5min to display filter context menu and additional 20-30min to do actual filtering based on color. I tried this process on a different PCs with 4 cores and plenty of RAM and 100.000 rows sheet
I then thought to write VBA, iterate column cells and if cell is colored, then delete entire row (this is possible in Excel 2010, with Cells().DisplayFormat) but processing takes even more time.
Can someone suggest a faster way to remove duplicates on large sheet?
EDIT: Note that I have used 2 functions. Of this, test is a function to test whether the function works (which you will have to modify per your scenario).
Also, I filled cell A1 to A100000 with test values. Please modify it per your needs.
Option Explicit
Function GetUniqueItems(ByVal src As Range) As Variant
Dim returnValue
Dim dictOfItemsWith1Value
Dim dictOfItemsWithMoreThan1Value
Dim countOfCells As Long
Dim counter As Long
Dim srcValues As Variant
Dim currentValue
Dim cell As Range
srcValues = src.Value
countOfCells = src.Cells.Count
Set dictOfItemsWith1Value = CreateObject("Scripting.Dictionary")
Set dictOfItemsWithMoreThan1Value = CreateObject("Scripting.Dictionary")
For counter = 1 To countOfCells
currentValue = srcValues(counter, 1)
If dictOfItemsWithMoreThan1Value.exists(currentValue) Then
dictOfItemsWithMoreThan1Value(currentValue) = dictOfItemsWithMoreThan1Value(currentValue) + 1
Else
If Not dictOfItemsWith1Value.exists(currentValue) Then
dictOfItemsWith1Value.Add currentValue, 1
Else
dictOfItemsWith1Value.Remove currentValue
dictOfItemsWithMoreThan1Value.Add currentValue, 1
End If
End If
Next
ReDim returnValue(1 To dictOfItemsWith1Value.Count, 1 To 1)
Dim key
counter = 1
For Each key In dictOfItemsWith1Value.keys
returnValue(counter, 1) = key
counter = counter + 1
Next
GetUniqueItems = returnValue
End Function
Sub test()
Debug.Print Now
Dim uniqueValues
uniqueValues = GetUniqueItems(Range("A1:A100000"))
Range("A1:A100000").ClearContents
Range("A1").Resize(UBound(uniqueValues, 1)) = uniqueValues
Debug.Print Now
End Sub
My way to deal with large excel files where I have to remove large chunks of data:
After the last column, use a countif() (much like KazJaw and DanM's countif)
=COUNTIF($A$1:$A$100000,A1)
$A$1:$A$100000 contains your ids. Change accordingly.
Drag the formula to the bottom (Fill Down, or select the range $B$1:$B$100000 if this is the column you put the helper column then Ctrl+D)
Copy column and paste values in place to remove the formula. This will prevent any recalculations during/after any filtering.
Sort by the column with the counts. This makes deleting the large portion of rows much faster later on.
Look for where you start to get counts of 2 and delete all rows till bottom.
Delete the helper column.
Now, if you want to restore the original order, put yet another column after the count, after step 3 above, and after step 5, sort this new column by ascending order before deleting it in step 6.
If you data is in located in column A, this formula should do what you need fairly efficiently:
=COUNTIF(A$1:A$100000,A1)
This formula counts how many times the value in A1 appears in the range A1:A100000. (The dollar signs keep that range from moving down as your drag your formula down.)
Place this in B1 and drag down* to B100000 (assuming you have 100,000 rows).
Then just do a filter on column B to show only 1. (More than 1 means you have duplicates and shouldn't show it.)
*A short cut for dragging down is to just select B1, then press Ctrl-End, then hold down shift and click B100000. Then do Ctrl-D (which is a shortcut for Fill Down).

Resources