Opening two separate Excel workbooks from a third - excel

I'm attempting to automate something I do each day and I am not getting very far.
We run a report from an HR system each day and then compare the Id's to
1) a list of Id's we are working on this fortnight
2) a list of Id's we worked on last fortnight
3) the report that came out yesterday - so that any that weren't on the first two lists but were picked up by someone yesterday get marked.
I am writing this code in a separate spreadsheet so that this remains each day and the downloaded spreadsheet gets updated.
I thought this would be easy, but it is a couple of years since I've written much vba. But no matter what I try I can't seem to get it to read the third file.
All files are open already.
So the first file is the macro file, which just allows the other files to be selected.
The second file is the Excel document which comes from the HR system. This has "Empl ID" as the first column from A2 up to around to A500 at times.
The third file is the Excel document which details the ID's we are working on this fortnight and has "Emplid" as the first column.
With the code below I can't get the third Excel doc to work, I just get Run time error 9 : subscript out of range.
If I add a watch for Workbooks(txtMSR) I can see the sheet "MSR" as Item1 in Sheets and the name for that is MSR.
Any assistance would be most welcomed.
Dim txtWorkbook As String
Dim vLoop, vLoop2 As Integer
Dim vEID As String
Dim txtMSR As String
Dim txtWork2 As String
'Get workbook name less the .xls bit
'C13 has ps.xls in it
txtWorkbook = Left(Range("C13"), InStr(Range("C13"), ".xls") - 1)
'Next check who has the employees on this MSR
'Set counters to "zero"
vLoop = 2
vLoop2 = 2
'C7 has MSR Fortnight 20190419-20190502.xlsm in it
txtMSR = Left(Range("C7"), InStr(Range("C7"), ".xlsm") - 1)
Do Until Workbooks(txtWorkbook).Sheets("ps").Range("A" & vLoop).Text = ""
vPMKeyS = Workbooks(txtWorkbook).Sheets("ps").Range("A" & vLoop).Value
```
'The line below produces the error.
```
Do Until Workbooks(txtMSR).Sheets("MSR").Range("A" & vLoop2).Text = ""
If (vPMKeyS = Workbooks(txtMSR).Sheets("ps").Range("A" & vLoop2).Value) Then
Workbooks(txtWorkbook).Sheets("ps").Range("N1").Text = "Y"
End If
vLoop2 = vLoop2 + 1
Loop
vLoop = vLoop + 1
Loop

Related

VBA code not finding date with DateSerial() function for one computer but finding for another

I have two PC's with the same worksheet. My code can find the expected date in one of the computers but not in the other one
I tried to change date format on the PC that wasn't working and this solved my problem, but I need a code that runs always, not depending on Windows date format
Workbook2.Activate
Sheets("Sheet1").Select
firstYear = Year(Cells(376, 2))
firstMonth = Month(Cells(376, 2))
firstDate = DateSerial(firstYear, firstMonth, 1)
Workbook1.Activate
Sheets("Sheet1").Select
Set oldforecast = Range("A9:A296").Find(firstDate)
The last line should find the date in Workbook1.xlsm for every computer that runs this code, despite it's date format.

Returning multiple values using Vlookup in excel

I have an excel sheet set up to automatically calculate meetings per day by day of the week. I would like to write a formula to return all dates I have a meeting scheduled (comma separated preferably), but I am having some difficulty. Using Vlookup, I can only get it to return the first date.
For example, here is what my data looks like:
A B C
Initial Meetings Follow-up Meetings Date
1 1 7/29/2015
0 1 7/30/2015
1 1 7/31/2015
0 0 8/1/2015
0 0 8/2/2015
I would like to write a formula to return "7/29/2015, 7/31/2015" in one cell, and "7/29/2015, 7/30/2015, 7/31/2015" in another, but I seem to be stuck.
You can't do this with vLookup.
This can be done relatively easily in a VB script, but it would affect portability as many if not most users disable macros by default and in many cases users are prevented from using Macros because their company disables them and makes it policy that users should not use them.
If you are OK with Macros, you can put the following into a new module and then use =MultiVlookup(lookup_value,table_array, col_index_num) in the same way as you'd use vlookup and it should give you a comma separated list of multiple matches:
Public Function MultiVlookup(find_value, search_range, return_row)
Dim myval ' String to represent return value (comma-separated list)
Dim comma ' Bool to represent whether we need to prefix the next result with ", "
comma = False
'Debug.Print find_value.value, return_row
For Each rw In search_range.Rows ' Iterate through each row in the range
If rw.Cells(1, 1).value = find_value Then ' If we have found the lookup value...
If comma Then ' Add a comma if it's not the first value we're adding to the list
myval = myval + ", "
Else
comma = True
End If
myval = myval + Str(rw.Cells(1, return_row).value)
End If
Next
MultiVlookup = myval
End Function
This may not be the cleanest way of doing it, and it isn't a direct copy of vlookup (for instance it does not have a fourth "range lookup" argument as vlookup does), but it works for my test:
Finally my original suggestion (in case it helps others - it's not the exact solution to the question) was:
I've not tried it myself, but this link shows what I think you might be looking for.
Great code, but don't forget to add the following is you use Option Explicit:
Dim rw As Range
WHEELS

VBA Excel Issue with Copying Workbook in another Workbook - application hangs on Copy on specific files

I have an issue that is honestly putting me at a loss.
I am copying a set of workbooks within a 'master' workbook (copying all the sheets). There are 2 methods I can use, either going through each sheet in the workbooks to copy each and every one in the master or else copy the workbook as a whole and place in the master workbook. I am using the second method using an array to discard sheets I dont need.
Dim ws() As String ' declare string array
ReDim ws(wb.Worksheets.Count) As String ' set size dynamically
Dim counter As Long ' running counter for ws array
counter = 0
For c = 1 to WS_Count
If wb.Worksheets(c).Name <> "TEST" Then
ws(counter) = wb.Worksheets(c).Name
counter = counter + 1
End If
Next
ReDim Preserve ws(counter-1) As String
wb.Worksheets(ws).Copy Before:=master.Worksheets(master.Worksheets.Count)
Both approaches I have tried work well with certain files however:
1) The first approach is problematic because it leaves a reference to the original file and so i moved to approach 2 which bypasses this issue as no reference is kept.
2) approach 2 is resulting in some sort of infinite loop in a certain file. the funny thing about this is that if i change the order in which they are merged the command doesnt get stuck and with another approx 50 workbooks the codes seems to work just fine. (please note that this issue doesn't occur with method 1 but method 1 has been discarded due to the file links)
The line it simply gets stuck on (no error) is
wb.Worksheets(ws).Copy Before:=master.Worksheets(master.Worksheets.Count)
Did anyone ever encounter this issue with a file not wanting to merge? Did i hit some limit somewhere? I'm at a loss because using 26 different workbooks, my code in its entirity managed to create a master workbook of 896 sheets. In this set that's getting stuck, i'm merging a 164 worksheet file with a new worksheet containing 164 files. I am using Office Professional Plus 2010.
I am currently hiding alerts, however I believe i was getting on of those messages where it asks me if i want to wait for the application.
Anyone can point me in the right direction please?
Since you are skipping "Test" pages have you tried starting with the last page and stepping -1?
For c = WS_Count to 1
If wb.Worksheets(c).Name <> "TEST" Then
ws(counter) = wb.Worksheets(c).Name
counter = counter - 1
End If
Next c

Turning an excel formula into a VBA function

I'm a bit new to trying to program and originally was just trying to improve a spreadsheet but it's gone beyond using a basic function in excel. I have a table that I am having a function look at to find a building number in the first column and then look at start and finish dates in two other respective columns to find out if it should populate specific blocks on a calendar worksheet. The problem occurs because the same building number may appear multiple times with different dates and I need to to find an entry that matches the correct dates.
I was able to create a working though complicated formula to find the first instance and learned I can add a nested if of that formula again in the false statement with a slight change. I can continue doing that but it becomes very large and cumbersome. I'm trying to find a way to make a function for the formula with a variable in it that would look at how many times the it has already been used so it keeps searching down the table for an answer that fits the parameters.
This is currently my formula:
=IFERROR(IF(AND(DATE('IF SHEET (2)'!$F$7,MATCH('IF SHEET (2)'!$C$2,'IF SHEET (2)'!$C$2:'IF SHEET (2)'!$N$2,0),'IF SHEET (2)'!C$4)>=VLOOKUP("2D11"&1,A2:F6,4,0),DATE('IF SHEET (2)'!$F$7,MATCH('IF SHEET (2)'!$C$2,'IF SHEET (2)'!$C$2:'IF SHEET (2)'!$N$2,0),'IF SHEET (2)'!C$4)<=VLOOKUP("2D11"&1,A2:F6,4,0)),IF(VLOOKUP("2D11"&1,A2:F6,3,0)="2D11",VLOOKUP("2D11"&1,A2:F6,6,FALSE)),"NO ANSWER"),"ERROR")
Where you see 2D11&1 is where I need the variable for 1 so it would be "number of times it's been used in the function +1" then I could just loop it so it would keep checking till it ran out of 2D11's or found one that matched. I haven't posted before and I'm doing this through a lot of trial and error so if you need more info please post and say so and I'll try to provide it.
So rather than have someone try to make sense of the rediculous formula I posted I though I would try to make it simpler by just stating what I need to accomplish and trying to see how to turn that into a VBA function. So I'm kinda looking at a few steps:
Matches first instance of building name in column A with
building name for the row of the output cell.
Is date connected with the output cell >= start date of first entry(which is user entered in column D).
Is date connected with the output cell <= end date of first entry(which is user entered in column E).
Enters Unit name(located in column F) for first instance of the building if Parts 1, 2, and 3 are all True.
If parts 1, 2, or 3 are False then loops to look at next instance of the building name down column 1.
Hopefully this makes things clearer than the formula so I'm able to get help as I'm still pretty stuck due to low knowledge of VBA.
Here is a simple solution...
Building_name = ???
Date = ???
Last_Row = Range("A65536").End(xlUp).Row
For i = 1 To Last_Row
if cells(i,1).value = Building_Name Then
if date >= cells(i,4).value Then
if date <= cells(i,5).value Then
first instance = cells(i,6).value
end if
end if
end if
next
you should add a test at the end to avoid the case where there is no first instance in the table
If I understand correctly, you have a Table T1 made of 3 columns: T1.building, T1.start date, T1.end date.
Then you have 3 parameters: P1=building, P2=start date, P3=end date.
You need to find the first entry in table T1 that "fits" within the input parameters dates, that is:
P1=T1.building
P2<=T1.start date
P3>=T1.end date
If so, you can define a custom function like this
Public Function MyLookup(Key As Variant, DateMin As Variant, DateMax As Variant, LookUpTable As Range, ResultColumn As Integer) As Range
Dim iIndx As Integer
Dim KeyValue As Variant
Dim Found As Boolean
On Error GoTo ErrHandler
Found = False
iIndx = 1
Do While (Not Found) And (iIndx <= LookUpTable.Rows.Count)
KeyValue = LookUpTable.Cells(iIndx, 1)
If (KeyValue = Key) And _
(DateMin <= LookUpTable.Cells(iIndx, 2)) And _
(DateMax >= LookUpTable.Cells(iIndx, 3)) Then
Set MyLookup = LookUpTable.Cells(iIndx, ResultColumn)
Found = True
End If
iIndx = iIndx + 1
Loop
Exit Function
ErrHandler:
MsgBox "Error in MyLookup: " & Err.Description
End Function
That may not be the most performant piece of code in the world, but I think it's explanatory.
You can download this working example

Excel ran out of resources while attempting to calculate one or more formulas

I have a workbook to do 'smart'-graphs on my expenses. It's been running for a year and there are now a lot of graphs and expenses. Excel now throws an out-of-resources error whenever I change anything or open the workbook. Thing is, I have lots of resources and its not using hardly any of them.
Win8 64bit w/ 8 core CPU and 32GB of ram
Office 2013 64bit
I have 2 sheets, the first sheet called Expenses has 3 columns [Date,Description,Amount] and about 1500 rows of data. The second sheet has a LOT (500 or so) of formulas that are all the same and aim to do "Sum all expenses between date X and Y where description matches -some needle-". The formula I have is this:
=
ABS(
SUMPRODUCT(
--(Expenses!A:A >= DATE(2011,12,1)),
--(Expenses!A:A < DATE(2012,1,1)),
--(ISNUMBER(FIND(C50,Expenses!B:B))),
Expenses!C:C
)
)
Can I give Excel more resources? (I'm happy for it to use all my ram, and chug my CPU for a few minutes).
Is there a more efficient way I can do this formula?
I understand that this formula is creating a large grid and masking my expenses list with it, and that for each formula this grid has to get created. Should I create a macro to do this more efficiently instead? If I had a macro, I would want to call it from a cell somehow like
=sumExpenses(<startDate>, <endDate>, <needle>)
Is that possible?
Thanks.
I had a similar problem where there were a few array formulas down about 150 rows and I got this error, which really baffled me because there really aren't that many formulas to calculate. I contacted our IT guy and he explained the following, some of which I understand, most of which I don't:
Generally when the computer tries to process large amounts of data, it uses multi-threaded calculation, where it uses all 8 processors that the computer tricks itself into thinking it has. When multi-threaded calculation is turned off, the computer doesn't throw the 'Excel ran out of resources...' error.
To turn off multi-threaded calculation, got to the 'File' tab in your Excel workbook and select 'Options'. On the right side of the box that appears select 'Advanced' and scroll down to the heading 'Formulas'. Under that heading is a check box that says 'Enable multi-threaded calculation'. Untick it, then select 'OK' and recalculate your formulas.
I had a go at creating a function that hopefully replicates what your current equation does in VBA with a few differences. Since I don't know the specifics of your second sheet the caching might not help at all.
If your second sheet uses the same date range for all calls to sumExpenses then it should be a bit quicker as it pre-sums everything on the first pass, If your date range changes throughout then its just doing a lot of work for nothing.
Public Cache As Object
Public CacheKey As String
Public Function sumExpenses(ByVal dS As Date, ByVal dE As Date, ByVal sN As String) As Variant
Dim Key As String
Key = Day(dS) & "-" & Month(dS) & "-" & Year(dS) & "_" & Day(dE) & "-" & Month(dE) & "-" & Year(dE)
If CacheKey = Key Then
If Not Cache Is Nothing Then
If Cache.Exists(sN) Then
sumExpenses = Cache(sN)
Exit Function
End If
Set Cache = Nothing
End If
End If
CacheKey = Key
Set Cache = CreateObject("Scripting.Dictionary")
Dim Expenses As Worksheet
Dim Row As Integer
Dim Item As String
Set Expenses = ThisWorkbook.Worksheets("Expenses")
Row = 1
While (Not Expenses.Cells(Row, 1) = "")
If Expenses.Cells(Row, 1).Value > dS And Expenses.Cells(Row, 1).Value < dE Then
Item = Expenses.Cells(Row, 2).Value
If Cache.Exists(Item) Then
Cache(Item) = Cache(Item) + Expenses.Cells(Row, 3).Value
Else
Cache.Add Item, Expenses.Cells(Row, 3).Value
End If
End If
Row = Row + 1
Wend
If Cache.Exists(sN) Then
sumExpenses = Cache(sN)
Else
sumExpenses = CVErr(xlErrNA)
End If
End Function
Public Sub resetCache()
Set Cache = Nothing
CacheKey = ""
End Sub
There could be many causes of this. I just wish Excel would tell us which one (or more) of the 'usual suspects' is committing the offence of RAM hogging at this time.
Also look for
Circular references
Fragmented Conditional formatting (caused by cutting, pasting, sorting, deleting and adding cells or rows.
Errors resulting in #N/A, #REF, #DIV/0! etc,
Over-use of the volatile functions TODAY(), NOW(), etc.
Too many different formats used
... in that order
While you're there, check for
Broken links. A formula relying on a fresh value from external data could return an error.
Any formulas containing #REF!. If your formulas are that messed these may well be present also. They will not cause an error flag but may cause some unreported errors. If your formulas are satisfied by an earlier condition the part of the formula containing #REF! will not be evaluated until other conditions prevail.
Fragmented conditional formatting was the case for me.
Older versions of the same workbook did not have an issue. Today, I cut/pasted many cells and the issue started occurring.
Removing the columns where I was cutting/pasting resolved the issue for me.
This is difficult to diagnose since conditional formatting does not immediately standout like normal formulas.

Resources