Excel VBA cross-sheet referencing - excel

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.

Related

Getting Excel to Copy Data From One Cell to Another Depending on Date

Apologies in advance as this is my first time posting something on this site and am not the best at explain issues.
I have a spread sheet, this has production data such as meters daily, meters monthly etc. These values are updated by adding TAGS from a PLC using Rockwell VantagePoint Excel add-in (if your unfamiliar with this it shouldn't matter this part is not what I am struggling with)
I need I way to copy data from one cell to another cell on the same sheet at month end. Basically the Meters monthly field needs to copied into another cell at the end of the month to record meters run for that month. The monthly meters run resets back to 0 at the end of the month.
Basically I need to copy the value in J7 into the corresponding month in W column at the end of that month. If it could ignore the year that would be advantageous as I don't need it to keep the old values and would mean I just need one column.
I have some experience at MS-Excel, also VBA but mainly in MS-Access never in MS-Excel. If answers could be explained as simply and hands on as possible it would be appreciated.
After Googling the issue I came across this formula and changed the ranges to fit my sheet but Excel doesn't like it saying it contains an error
=QUERY( A1:B6; "select B where A =date """&TEXT(TODAY();"yyyy-mm-dd")&""" "; 0
Sorry again if I haven't explained myself properly.
If your workbook isn't guaranteed to be open at the end of each month I would update the value every time it gets opened, like(Should be placed in ThisWorkbook):
'Runs when you open the workbook
Private Sub Workbook_Open()
'Loops through U3 to the last used cell in that column
For Each c In Range(Cells(3, 21), Cells(Rows.Count, 21).End(xlUp))
'Applies the J7 value to the current month and exits the sub
If Month(c) = Month(Now) Then c.Offset(, 2).Value = [J7]: Exit Sub
Next c
End Sub
Also, not that it matters but, I would apply the following formula in U3:U14 to always get the correct dates:
=EOMONTH(DATE(YEAR(TODAY()),ROW()-2,15),0)
Okay, I'm still not super sure what the question is and I know more Access VBA than Excel VBA, but here's something that might help to find a solution.
You can make a check date function that returns a Boolean value:
Public Function EoMonthCheck() As Boolean
Dim eo_month As Date, today As Date
eo_month = Format(WorksheetFunction.EoMonth(Now(), 0), "yyyy-MM-dd")
today = Format(Now(), "yyyy-MM-dd")
If today = eo_month Then
EoMonthCheck = True
Else
EoMonthCheck = False
End If
End Function
And the,, to add a value to the "W" column, we might use something like this:
Public Function AppendValue(Optional target_cell As String = "J7")
''' This could be a subroutine, too, I guess, since we're not returning anything.
Dim i As Integer
''' Activate whatever sheet you want to work with
Worksheets("Sheet1").Activate
If EoMonthCheck() = True Then
''' Look up the bottom of the 'W' column and find the first non-empty cell
''' Add 1 to that cell to get you to the next cell (the first empty one).
i = Cells(Rows.Count, "W").End(xlUp).Row + 1
''' Set the value of that empty cell in the 'W' column to the value of 'J7'
''' which will happen after we evaluate whether it is the end of the month.
Cells(i, "W").Value = Range(target_cell).Value
End If
Then, you could maybe trigger that each time the workbook opens.

Copy cell range and paste in another worksheet based on the date?

I've scoured the interwebs for any kind of solution and I keep coming up empty so hopefully someone can help me out. I have two sheets, Sheet1 and Inventory. In Sheet1, the user enters the date in B1. In range C4:C200 I have a list of supplies and in range D4:D200 a user enters the number of each of the supplies on hand. In Inventory, the list of supplies is in range A1:A200, and b1:z1 list dates.
I'm trying to create a macro that will look in Sheet1 for the date entered in B1, let's say 4/1/19, copy D4:D200, then look in Inventory, find 4/1/19 in rows b1:z1 and paste the copied data beneath the correct date. So if 4/1/19 is in cell E1, the values would be pasted in E2.
While I'm decent with cell formulas and functions, I'm new to macros, so I'm not sure what to do.. Any help is greatly appreciated!
I tried to write some very basic code in such way you can easily read it. It is not the most sophisticated code but it will do the job. Just a few things i noticed: The number of supplies are in a list 197 long, the sheet Inventory states lists of 200 items...well, you can easily adjust the macro below. Copy past the code in a new module and run it. If you encounter any problems please post the complete workbook and i will have a look. Make sure that cell a1 on inventory is not empty.
Sub DoYourThing()
Dim c As Integer
c = findHorizontal("Inventory", 1, Sheets("Sheet1").Cells(1, 2).Value)
'now we know what column the date is in
For i = 2 To 200
Sheets("Inventory").Cells(i, c) = Sheets("Sheet1").Cells(i + 2, 5)
Next i
End Sub
Function findHorizontal(Sheet As String, row As Integer, Value As Variant) As Integer
'searches a row from left to right until the cells are empty
Dim i As Integer
i = 1
Do While Not IsEmpty(Sheets(Sheet).Cells(row, i))
If Sheets(Sheet).Cells(row, i) = Value Then
findHorizontal = i
Exit Function
End If
i = i + 1
Loop
findHorizontal = -1
End Function

Creating a record for generated numbers in VBA

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

Averaging over a Non-Contiguous Named Range

I am trying to average non-contiguous cells as shown.
I am taking the average of columns A and C for each row. I am trying to do the same but with a named range (including columns A and C), because my actual data have thousands of columns and it will be hell to write the formula let alone for the users to understand what is being averaged.
Obviously, I don't understand how indexing a named range works. I expected that index(RangeAC,2) would give me the second row of values in RangeAC. Instead, I get the second row in column A. Trying index(RangeAC,2,2) results in an error.
Is it possible to get this average with a named range or do I need a different approach?
I don't know if I'm missing something, but isnt this as simple as using the Excel intersect operator?:
=AVERAGE(RangeAC 8:8)
Put in the first row of the named Range data(which seems to be 8:8 in your case), and copy down...
Isnt that the same as the suggested VBA UDF from MrExcel forums?
Option 1:
Lets say the name of your range is my_data like this one:
This is the formula to use:
Public Function calculate_avg(rng As Range) As Double
calculate_avg = WorksheetFunction.Average(Range(rng.Cells(1, 1).Address, Cells(rng.Rows.Count + rng.Cells(1, 1).Row - 1, rng.Columns.Count + rng.Cells(1, 1).Column - 1).Address))
End Function
Option 2:
Your named range is the following:
You want the average of the 2. and the 3. column. (C&D).
This is how you get it:
Option Explicit
Public Function calculate_avg(rng As Range, Optional l_starting_col As Long = 1, Optional l_end_col As Long = 1) As Double
Dim my_start As Range
Dim my_end As Range
Set my_start = Cells(rng.Cells(1, 1).Row, l_starting_col + rng.Cells(1, 1).Column - 1)
Set my_end = Cells(rng.Cells(rng.Rows.Count, l_end_col).Row, rng.Columns.Count - rng.Cells(1, l_end_col).Column + l_end_col)
'Debug.Print my_start.Address
'Debug.Print my_end.Address
calculate_avg = WorksheetFunction.Average(Range(my_start, my_end))
End Function
You pass as arguments the starting and the end column. Thus something like this:
?calculate_avg([my_test_big],2,3) in the immediate window returns 72,5. The same can be used as an Excel formula. Good luck! :)+
Option 3
Public Function calculate_avg_row(rng As Range, Optional l_row As Long = 1) As Double
Dim my_start As Range
Dim my_end As Range
Set my_start = Cells(rng.Cells(l_row, 1).Row, rng.Cells(l_row, 1).Column)
Set my_end = rng.Cells(l_row, rng.Columns.Count)
Debug.Print my_start.Address
Debug.Print my_end.Address
calculate_avg_row = WorksheetFunction.Average(Range(my_start, my_end))
End Function
This one works like this:
calculate_avg_row([test_rng],5)
And gives the average of the 5th row of the named range, including all columns of the named range.
Could you not attach a name to a formula as well? If so,go to the "Formula" tab , "Define Name"and type in the "Refers to" box =Average(A1,C1)). In the name box, you could name it "Average" or whatever you choose to call it.The references would continue to be non-contiguous if you dragged to the right or down the sheet. I am not sure if that is exactly what you're seeking.
I appreciate everyone's help. This problem has taken me considerably longer than I was willing to spend on it. Non-contiguous ranges are a nightmare in Excel.
Eric at Mr Excel proposed the most elegant working solution - just one line of VBA.
The third parameter of the Index function Reference form can be used to specify the area number:
= AVERAGE( INDEX(RangeAC, ROW()), INDEX(RangeAC, ROW(), , 2) )
or if RangeAC does not start at row 1, something like:
= AVERAGE( INDEX(RangeAC, ROW()-ROW(RangeAC)+1), INDEX(RangeAC, ROW()-ROW(RangeAC)+1, , 2) )

Excel Lookup return multiple values horizontally while removing duplicates

I would like to do a vertical lookup for a list of lookup values and then have multiple values returned into columns for each lookup value. I actually managed to do this after a long Google search, this is the code:
=INDEX(Data!$H$3:$H$70000, SMALL(IF($B3=Data!$J$3:$J$70000, ROW(Data!$J$3:$J$70000)-MIN(ROW(Data!$J$3:$J$70000))+1, ""), COLUMN(A$2)))
Now, my problem is, as you can see in the formula, my lookup range contains 70,000 rows, which means a lot of return values. But most of these return values are double. This means I have to drag above formula over many columns until all lookup values (roughly 200) return #NUM!.
Is there any possible way, I guess VBA is necessary, to return the values after duplicates have been removed? I'm new at VBA and I am not sure how to go about this. Also it takes forever to calculate having so many cells.
[Edited]
You can do what you want with a revised formula, not sure how efficient it will be with 70,000 rows, though.
Use this formula for the first match
=IFERROR(INDEX(Data!$H3:$H70000,MATCH($B3,Data!$J3:$J70000,0)),"")
Now assuming that formula in in F5 use this formula in G5 confirmed with CTRL+SHIFT+ENTER and copied across
=IFERROR(INDEX(Data!$H3:$H70000,MATCH(1,($B3=Data!$J3:$J70000)*ISNA(MATCH(Data!$H3:$H70000,$F5:F5,0)),0)),"")
changed the bolded part depending on location of formula 1
This will give you a list without repeats.....and when you run out of values you get blanks rather than an error
Not sure if you're still after a VBA answer but this should do the job - takes about 25 seconds to run on my machine - it could probably be accelerated by the guys on this forum:
Sub ReturnValues()
Dim rnSearch As Range, rnLookup As Range, rnTemp As Range Dim varArray
As Variant Dim lnIndex As Long Dim strTemp As String
Set rnSearch = Sheet1.Range("A1:A200") 'Set this to your 200 row value range
Set rnLookup = Sheet2.Range("A1:B70000") 'Set this to your lookup range (assume 2
columns)
varArray = rnLookup
For Each rnTemp In rnSearch
For lnIndex = LBound(varArray, 1) To UBound(varArray, 1)
strTemp = rnTemp.Value
If varArray(lnIndex, 1) = strTemp Then
If WorksheetFunction.CountIf(rnTemp.EntireRow, varArray(lnIndex, 2)) = 0 Then 'Check if value exists already
Sheet1.Cells(rnTemp.Row, rnTemp.EntireRow.Columns.Count).End(xlToLeft).Offset(0, 1).Value =
varArray(lnIndex, 2)
End If
End If
Next Next
End Sub

Resources