Table Reference in Formula Changes When Worksheets Copied - vba

I have two sheets in "Property" Workbook that I am copying to "UQP" Workbook.
PropertyCoverage - Houses formula =VLOOKUP("PF",tPremium,2,0) among other text and simple SUM formula.
xmlProperty - Houses table tPremium (among other tables; all tables mapped to XML Source)
When I copy these two sheets (simultaneously) into the UQP workbook the tPremium reference in the formula in the PropertyCoverage sheet automatically changes to tAutoForms, which is another table in the UQP workbook (that has nothing to do with the formula). UQP workbook has several other sheets and tables.
I don't know why this changes automatically, but I think it has something to do with the fact that Excel cannot copy multiples sheets when at least one sheet contains a table.
I have tried the solution below (referenced from here). However, the same issue happens. The issue does not happen if I copy to a new workbook. ... Bear with ActiveWorkbook, etc, I only used this as test to see if it would work
Sub Copy_Worksheets()
Dim wbMaster As Workbook
Set wbMaster = Workbooks("UniversalQuoteProposal.xlsb")
Dim TheActiveWindow As Window
Dim TempWindow As Window
With ActiveWorkbook
Set TheActiveWindow = ActiveWindow
Set TempWindow = .NewWindow
.Sheets(Array("PropertyCoverage", "xmlProperty")).Copy Before:=wbMaster.Worksheets(1)
End With
TempWindow.Close
End Sub
Here is my original copy code:
Sub CopySheetsToMaster()
Dim wbMaster As Workbook
Set wbMaster = Workbooks("UniversalQuoteProposal.xlsb")
Dim sSheetName As String
sSheetName = Replace(ThisWorkbook.Name, ".xlsb", "")
Dim sSheets As Variant
sSheets = Array(sSheetName & "Coverage", "xml" & sSheetName)
'*** => This is where tPremium gets automatically changed to tAutoForms
ThisWorkbook.Worksheets(sSheets).Copy Before:=wbMaster.Worksheets(1)
wbMaster.ChangeLink ThisWorkbook.FullName, wbMaster.FullName, xlLinkTypeExcelLinks
End Sub
Lastly, I can work around this by doing a Replace after the sheets are copied, but since this will scale out to a need to bring a possible 7-10 other workbooks with potential formula references to tables and such, I would rather find a cleaner solution if it exists.
Lastly, I am using Excel 2010.

Related

ms-Excel Worksheet transfer between worksbooks and vlookup

I have a simple problem(at least seems to be) that I just cannot seem to be able to find a good solution to:
I have 4 workbooks, that all contain two of the exact worksheets(rest of the worksheets are unique for each workbook). I am storing these two worksheets in a seperate workbook(so 5th workbook). Out of these 2 worksheets, 1 of them is a Data sheet made up of many tables, which I do updates on and the other one is a sheet called V, which just uses some vlookup functions to bring up the related data from this Data sheet.
I am trying to find a way to be able to pass along this data sheet to each individual workbook, instead of editing the data sheet individually for each workbook(All 4 of them).
I was able to come up with the following macro, which checks if the sheet already exists and if it does it deletes it. Then it opens up location of the excel file, copies this worksheet to the workbook and therefore I have the most "updated" version of this data worksheet.
Sub UpdateT()
Sheets("data").Visible = True
Dim wb As Workbook
Dim aw As Workbook
''Open 2nd Workbook
Set aw = Application.ActiveWorkbook
'Check if data worksheet exists, and if it does delete it
If Not GetWorksheet("data") Is Nothing Then
Application.DisplayAlerts = False
Worksheets("data").Delete
Application.DisplayAlerts = True
End If
'Check if T worksheet exists, and if it does, delete it
If Not GetWorksheet("T") Is Nothing Then
Application.DisplayAlerts = False
Worksheets("T").Delete
Application.DisplayAlerts = True
End If
Set wb = Workbooks.Open(Filename:="C:\Users\yilmadu001\Desktop\Update.xlsx")
'Copy To Different Workbook
wb.Sheets("data").Copy _
After:=aw.Sheets("Data1")
wb.Sheets("5120 TI").Copy _
After:=aw.Sheets("MENU5120")
'Close 2nd Workbook
aw.Save
wb.Close
'Hide the data worksheet
aw.Sheets("data").Visible = False
End Sub
'Function to check if worksheets exist
Function GetWorksheet(shtName As String) As Worksheet
On Error Resume Next
Set GetWorksheet = Worksheets(shtName)
End Function
The problem is the following:
When the new Data worksheet is transferred, the V worksheet is no longer working with the Vlookup function to be able to point to the relative information. So then I thought, okay what if I transfer BOTH Data and V worksheets, however that also did not work.
Is there a way to be able to use Vlookup, while copying the Data sheet? (The name is exactly the same I do not understand why it does not seem to be able to point to the cells of the table). It just looks blank, can't point to anything.
NOTE: I am not changing the format of the Data tables, basically just the values, so the format is the exactly the same.
It is probably important to note that the main excel workbooks(the 4) are in use 24/7, therefore I cannot go the other way(Update from Data workbook to the main workbook). I must "pull" the updated worksheet rather than "push".
If anyone has any suggestions I'd really appreciate. Thank you.

Comparing columns in different excel 2013 files and deleting the duplicates from one of the workbooks (need macro)

This is my first question on this site and I'm not a programmer, so please bear with me.
I am trying to create an Excel 2013 macro that will compare values in column A on one workbook ("active workbook") to column A's of other Excel files in a particular directory. Duplicate values (rows) would then be deleted from the active workbook.
I have been working piece by piece trying to figure this out as I am not a programmer. So far I have been able to use conditional formatting to highlight unique values when the two columns are side by side (same worksheet). I used =ISNA(MATCH($A2,$B$2:$B$12,0)).
Then I used a macro to print out the duplicate values to another column (instead of highlighting them.. I am still at this stage comparing two columns within the same worksheet). I did this by using the following macro:
Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant
' Set CompareRange equal to the range to which you will
' compare the selection.
Set CompareRange = Range("C1:C12")
' NOTE: If the compare range is located on another workbook
' or worksheet, use the following syntax.
' Set CompareRange = Workbooks("Book2"). _
' Worksheets("Sheet2").Range("C1:C5")
'
' Loop through each cell in the selection and compare it to
' each cell in CompareRange.
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 1) = x
Next y
Next x
End Sub
Then I tried removing duplicate values from two different worksheets but that didn't work:
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range
Dim Counter As Integer
Set wb1 = ActiveWorkbook
Set PasteStart = [RRimport!A1]
Pathname = ActiveWorkbook.Path & "\For Macro to run\"
Filename = Dir(Pathname & "*.xls")
Do While Filename <> ""
Set wb2 = Workbooks.Open(Pathname & Filename)
For Each Sheet In wb2.Sheets
With Sheet.UsedRange
.Copy PasteStart
Set PasteStart = PasteStart.Offset(.Rows.Count)
End With
Next Sheet
wb2.Close
Filename = Dir()
Loop
End Sub
I've been reading this site for couple of days and also searched through YouTube. I haven't had much success after the first two basic things I did.
Background of the project: Everyday we have a list called "Pending List" which essentially is all of the projects we need to get done. Everyday this list grows. Each project is given a unique identifier (numeric value) that is listed in column A of the active workbook. Every day I create my own files of the projects that are being completed. Instead of manually checking off each project one by one by comparing several files every day, I would like Excel to be able to delete the duplicates (meaning the projects that are both on my pending list and in the other files, and only leave the unique projects that still need to be done. Hope I didn't confuse anyone but if I did, please let me know.
The question here:
I am trying to create an Excel 2013 macro that will compare values in
column A on one workbook ("active workbook") to column A's of other
Excel files in a particular directory. Duplicate values (rows) would
then be deleted from the active workbook.
So, let's break this down:
There is a directory from which workbooks need to be opened.
When one of the workbooks is open, you want to check column A (I assume this is on the first worksheet for the sake of the example below) for values you have in column A in your active workbook (the one that will run the macro).
If there's a match, delete the row from the active workbook in which the value was stored.
When done, continue with the next workbook in the directory.
Point 1 and 4: Open some files from a specific directory:
We will need some function to open and close the files. This question has been asked many times on SO, for example here
Also, we're going to need the workbooks to be stored in some variable that we will pass to the comparison in the next step.
Public Sub LoopOverFiles()
'Our variables:
Dim wb1 As Workbook 'To hold the active workbook / the macro workbook
Dim wb2 As Workbook 'To hold the workbook we'll be comparing to later on
Dim scanFolder As String 'To set the folder in which the files will be located
Dim fileNameToOpen As String 'To get the filenames that we will open
Set wb1 = ThisWorkbook
scanFolder = "C:\temp\"
fileNameToOpen = Dir(scanFolder & "*.xlsx")
'And loop over the files:
Do While Len(fileNameToOpen) > 0 'To exit the loop when there's no more xlsx files
Set wb2 = Workbooks.Open(scanFolder & fileNameToOpen)
'To do the actual comparison of the 2 workbooks, we call our compare routine.
DoTheComparison wb1, wb2 'Note we'll be passing the two workbooks as parameters to the compare function
wb2.Close SaveChanges:=False 'We don't want to leave it open after we're done with it.
fileNameToOpen = Dir 'To continue with the next file.
Loop
End Sub
Point 2 and 3: Do the comparison and delete some rows
As you can see, the actual comparison will be done by a routine that's called DoTheComparison and that takes 2 workbooks as parameters. Based on the first routine, we know that the workbooks that will be passed are the correct ones (wb1 being the active one, wb2 being the variable one that gets opened during the loop).
In this example we'll stick to the first worksheet in wb2.
Public Sub DoTheComparison(wb1 as Workbook, wb2 as Workbook)
'Dim compareFrom as Range - Not needed.
Dim compareTo as Range
Dim compareFromCell as Range
Dim compareToCell as Range
Dim i as Integer
'EDIT: Since we delete, we need a backwards loop. This can't be done with "for each" so we'll use "for" with step -1.
'That is why we also don't need the "CompareFrom" range variable anymore.
Set compareTo = wb2.Worksheets(1).Range("A2:A20")
For i = 20 to 2 step -1
Set compareFromCell = wb1.Worksheets("RemoveValsFromHere").Range("A" & i) 'We get the cells based on the index.
For Each compareToCell in compareTo
If compareFromCell.Value = compareToCell.Value Then 'Point 3:
compareFromCell.EntireRow.Delete shift:=xlUp
Exit For
'Note that we need to exit the inner loop:
'After a match was found, the "compareFromCell" is deleted after all.
'Therefore we have to continue with the next compareFromCell, otherwise we'll get an error.
End If
Next compareToCell
Next i
End Sub
Note that especially DoTheComparison is written for maximum clarity, not for optimal speed (far from it!). I see in your question you've been looking into comparing variants / arrays, which is indeed a lot faster.
EDIT: I altered the code above since you're facing the "skipping cells" issue due to cell deletion. In short: The index changes, so when moving to the next cell after deletion the index is wrong. The fix is an easy backwards for loop. Also see this question and answer

Copy and moving an entire sheet to another workbook. 1mil rows to 65536 rows

The following is part of my code that involves copying an entire named sheet from one master file to a new unsaved file that's being worked on:
ActiveWorkbook.Sheets("VehicleList").Copy _
After:=Workbooks(2).Sheets(1)
So this worked fine to place the sheet into workbook 2 but now the files we're dealing with are in old excel mode which is throwing up the following error due to old excel having less rows:
"Excel cannot insert the sheets into the destination workbook, because it contains fewer rows and columns"
How can I tweak the copy and pasting into Workbooks(2) without breaking the code? I thought defining a range of 1000 rows to copy and move would work, but this also gave an error. Thanks for your help.
Assuming you just want the values (i.e. I'm speeding it up by not doing a copy paste) you can do:
Workbooks(2).Sheets.Add After:=Sheets(1)
Workbooks(2).Sheets(2).Range("A1:F1000").Value = ActiveWorkbook.Sheets("VehicleList").Range("A1:F1000").Value
I'd go like follows
Option Explicit
Sub main()
Dim targetWs As Worksheet
With Workbooks("MyWorkbookname").Sheets("VehicleList") '<--| fully qualify reference wanted worksheet in the wanted workbook
Set targetWs = SetOrGetSheet(Workbooks(2), .name) '<--| get the (new) target worksheet on the target workbook named after referenced sheet
Intersect(.Range("A1:F1000"), .UsedRange).Copy targetWs.Cells(1, 1) '<--| copy range to target worksheet on the target workbook
If targetWs.name <> .name Then MsgBox "a new sheet has been created in " & targetWs.Parent.name & " with name " & targetWs.name
End With
End Sub
Function SetOrGetSheet(targetWb As Workbook, shtName As String) As Worksheet
targetWb.Worksheets.Add '<--| add a new sheet in the target workbook
On Error Resume Next
Set SetOrGetSheet = targetWb.Worksheets(shtName) '<--| try and get any possible target workbook sheet with the passed name
If SetOrGetSheet Is Nothing Then targetWb.ActiveSheet.name = shtName '<--| if target workbook has no worksheet with passed name then name the new one after it
Set SetOrGetSheet = targetWb.ActiveSheet 'return the new worksheet
End Function
should you be afraid your range-to-copy could exceed 65 rows and/or 256 columns than you should add its size check
edit for values pasting only
should you be interested in pasting values only then you can go like follows:
Sub main()
SetOrGetSheet(Workbooks(2), "VehicleList").Range("A1:F1000").value = ActiveWorkbook.Sheets("VehicleList").Range("A1:F1000").value '<--| copy values form source to target worksheet
End Sub
while SetOrGetSheet() function stays the same as above
as you may have guessed that function is there for a more general approach where you may want (or just have) to handle the possibilty of target workbook having a worksheet named after "VehicleList" already

Sheets that have almost the same name

Im trying to open and copy the cells from a sheet from a different excel file. I have no problem in opening, copying and closing the excel file that I need.In this case, I have With x.Sheets("Documents").UsedRange. Most files that I needed to copy the cells from have "Documents" as a sheet name, but some have "Documents" + other different characters (example, "DocuemntsEX"). When I tried to copy, it shows 'Subscript Out-of-range' since the "DocumentEX" is different from "Document". Is there any way that I can retain the specific name of the sheet, since most of the files have that name? Is there any code that can help me to access those sheet with a different sheetname? Just hit me up if you need clarifications.
Use a wildcard character to get the sheet first:
Function GetDocumentSheet(ByRef wb As Workbook) As Worksheet
For Each ws In wb.Sheets
If LCase$(ws.Name) Like "documents*" Then
Set GetDocumentSheet = ws
GoTo SheetFound:
End If
Next
Set GetDocumentSheet = Nothing
SheetFound:
End Function
In your code:
Set mySheet = GetDocumentSheet(x) '// where 'x' is your workbook object
Then reference
mySheet.UsedRange
As i said in comment, you can use sheets by number, or you can use something like this
Sub findSheet()
Dim sheetSubName As String
sheetSubName = "fluff"
Dim currentSheet As Worksheet
For Each currentSheet In Sheets
If currentSheet.Name Like sheetSubName & "*" Then
MsgBox "do some stuff"
End If
Next currentSheet
End Sub
When you comparing sheet name to string and regular character (in my example * so its anything). So this macro will work with sheet fluff, fluffy fluffiest etc.
And everything to looping via Sheets (all sheet in workbook) and comparing their names via Like (something like = ) but it can use some basic regular expression.

How to access a closed Excel Workbook using vlookup vba

I'm trying to create a Excel VBA macro that uses VLOOKUP to access a range of cells in a closed workbook. I'm not too good at using the VBA editor, but it doesn't seem to show a lot of useful information about errors.
Sub WorkBookWithData()
Dim currentWb As Workbook
Set currentWb = ThisWorkbook
Dim currentWs As Worksheet
Set currentWs = currentWb.Sheets(1)
Dim strFormula As String
strFormula = "=VLOOKUP(currentWs.Range("B2"),'Macintosh HD:Users:myself:Documents:l[Master_Terms_Users.xlsm]Master_Terms_Users.csv'!A1:B222,2,false)"
currentWs.Range("C2").Formula = strFormula
End Sub
Excel VBA editor is hanging up on the "strFormula = "=VLOOKUP..." section.
Thanks
Reference from Siddharth Rout's comments.
The main problem in your code is this line:
strFormula = "=VLOOKUP(currentWs.Range("B2"),'Macintosh HD:Users:myself:Documents:l[Master_Terms_Users.xlsm]Master_Terms_Users.csv'!A1:B222,2,false)"
because of this code currentWs.Range("B2"). We know that you want to indicate Range("B2") of Current Sheet(same sheet). So, you can use as follow:
strFormula = "=VLOOKUP(B2,'Macintosh HD:Users:myself:Documents:l[Master_Terms_Users.xlsm]Master_Terms_Users.csv'!A1:B‌​222,2,false)"
Why? It can use just B2 because you set formula to a cell which is in the same sheet. So, it is not need to indicate the Sheet Name.
And If you want to set a cell which is from other sheet, you need to indicate Sheet Name in that case. So, should use as follow:
strFormula = "=VLOOKUP(" & currentWs.name & "!B2,'Macintosh HD:Users:myself:Documents:l[Master_Terms_Users.xlsm]Master_Terms_Users.csv'!A1:B222,2,false)"
This looks nothing like what I had previously, but it works.
Sub Check_Master_Values()
Dim newCurWb As Workbook
Set newCurWb = Workbooks(2)
newCurWb.Activate
newCurWb.Sheets(1).Range("C2").Formula = "=VLOOKUP(B2,'Macintosh HD:Users:myself:Documents:[Master_Terms_Users.xlsm]Master_Terms_Users.csv'!$A$1:$B$269,2,FALSE)"
End Sub
In my first attempt, I didn't follow the chain of assignments from workbook, to sheets, to ranges. As you can see in this code, I Dim a new Workbook - then the big ah-ha moment, I needed to assign it to the correct open workbook. Then, I activated the workbook, and finally accessed the Sheets object and Range.
I also know now that my workbook selection number will vary depending on how many other workbooks are open. The ThisBook didn't work because somehow in the process, the workbook that ThisBook referenced, changed. That is probably also why my initial code didn't work, in addition to the improper coding in the VLOOKUP.
It would be good if there was a way to specify which workbook on the fly.
Thanks to everyone who gave help on the VLOOKUP part.