Excel, VBA: Referencing other Sheets when a Value changes in 1 sheet (Intersect) - vba

I have been trying to get this to work, but I couldn't so far, and after searching I couldn't quite find a solution online either, so here it goes.
I have 3 sheets I'm using.
"wsPunting" (The one where the value changes)
"wsDetail" (The Sheet with complete data of everything)
"wsData" (The Sheet where I store certain data that I grab with macros)
Now, what I'm trying to do, is that when a Value changes in cell B2 in wsPunting (B2 is Data Validation made with a macro, not sure if this is valuable info, but better put it in here just in case), I filter my data in wsDetail, grab Column "O3:O", Remove Duplicates, and Assign that into a Data Validation in Cell B5 in wsPunting.
I got this to work already when I had <20 values entered. Now, when I pasted the actual Data that I was going to use in wsDetail, I kept getting "Type Mismatch" on the Intersect.
I've tried a few things already that I though might perhaps fix it, but I just can't seem to find it.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error GoTo Booboo
Dim rngFSU As Range
Dim vFSU As Range
Dim wsPunting As Worksheet, wsData As Worksheet, wsDetail As Worksheet
Set wsPunting = ActiveWorkbook.Sheets("Puntingsblad")
Set wsData = ActiveWorkbook.Sheets("Data")
Set wsDetail = ActiveWorkbook.Sheets("Detail")
Set rngFSU = wsPunting.Range("$B$2")
Set vFSU = wsPunting.Range(Target.Address)
'The next line is where it keep dropping the error
If Not Intersect(rngFSU, vFSU) Then
wsDetail.Range("A2", wsDetail.Range("A3").SpecialCells(xlCellTypeLastCell)).AutoFilter Field:=1, Criteria1:=Range("B2").Value
wsDetail.Range("O3", wsDetail.Range("O3").SpecialCells(xlCellTypeLastCell)).Copy
wsData.Range("B2").PasteSpecial xlPasteValues
wsData.Range("B2", wsData.Range("B1").End(xlDown)).RemoveDuplicates Columns:=Array(1)
With wsPunting.Range("B5").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=Data!" & wsData.Range("B2", wsData.Range("B1").End(xlDown)).Address
.IgnoreBlank = True
End With
wsDetail.Range("A2", wsDetail.Range("A3").SpecialCells(xlCellTypeLastCell)).AutoFilter Field:=1
End If
Booboo:
MsgBox err.Description
End Sub
This is actually my last resort, concidering I usually try fixing it myself to learn faster. But I've been stuck on this one for so long already, I just can't anymore atm.
Cheers in advance.

If Not Intersect(rngFSU, vFSU) Then
Intersect(rngFSU, vFSU) is an object of type Range, you are trying to cast it into a boolean.
This leads to an error. I understand that you want to check if there is no intersection, in which case the Range returned by Intersect is Nothing. So try this:
If Intersect(rngFSU, vFSU) Is Nothing Then

Related

Can't for the life of me figure out what is causing this mismatch error VBA Excel?

I have this code which is causing a mismatch error and I can't figure out why I had it working sort of before with the mismatch error and in an attempt to fix it I can't get it back to working. The values in the merge sheet are all numeric. Basically what I was trying to do was when a value is entered into a cell there would be a VLookup would be executed to input a value into the adjacent cell and once I get this working, more cells in the same row. If any of you are itching to fix something just let me know!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim LooupValue As String
Dim sfx As Long
Set KeyCells = Columns(1)
LooupValue = ActiveCell.Value
sfx = Application.VLookup(LooupValue, Worksheets("Merge").Range("D:BD"), 2, False)
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Range(Target.Address).Offset(0, 1).Value = sfx
End If
End Sub
Edit: Thanks to #Marcucciboy2, #MathieuGuindon, and #BigBen for their successful help, I have done some more research and posted what solved my issue down below.
Dim sfx As Long
sfx = Application.VLookup(LooupValue, Worksheets("Merge").Range("D:BD"), 2, False)
If the vlookup yields xlErrNA i.e. #N/A, then VBA can't coerce its result into a Long, and you get exactly that: a type mismatch error - because xlErrNA is an Error value, which can't be implicitly converted to a String, a Long, or anything. The only type that can contain this data, is a Variant.
Dim result As Variant
result = Application.VLookup(LooupValue, Worksheets("Merge").Range("D:BD"), 2, False)
Dim sfx As Long
If Not IsError(result) Then
sfx = CLng(result)
Else
'lookup yielded no match
End If
Also, it looks like this is off-by-one:
LooupValue = ActiveCell.Value
The ActiveCell likely isn't the same cell as Target, which is the cell that was modified. You probably need this instead:
LookupValue = Target.Value
I'd also recommend making unqualified Range (same with Rows, Colomns, Names, and Cells) calls explicitly qualified - because that exact same code behaves differently depending on where it's written in. By qualifying them with Me, you're making your code more explicit. Code that says what it does, and does what it says, is always better code.
Worksheets("Merge") is a smell: if the sheet exists in ThisWorkbook at compile-time, give it a code name (i.e. set its (Name) property) and use that identifier directly:
result = Application.VLookup(LooupValue, MergeSheet.Range("D:BD"), 2, False)
If the sheet only exists at run-time (e.g. it's in a workbook that was opened by the macro), then you should have a reference to that workbook near where you opened that file, e.g. Set book = Application.Workbooks.Open(path) - use that reference to qualify the Worksheets member call, instead of implicitly referring to ActiveWorkbook.
The lookup range D:DB is excessive when you're only looking for the value in column E. If that hard-coded 2 is there to stay, I'd make the lookup range be D:E.
I would also nest the value setting within the "If" that checks for intersection; otherwise, every time you change the worksheet it does an unnecessary vlookup in the background.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
Target.Offset(0, 1).value = Application.VLookup(Target.value, Worksheets("Merge").Range("D:BD"), 2, False)
End If
End Sub
I figured out what the last problem was... The lookup column was, for some reason from the previous document editor, formatted as text. The reason why only some lookup values were working was because even after I formatted the entire column to numbers, the said values were reformatted as numbers only after I had edited the cell. I wasn't going to edit every single cell so I did some research and found out how to refresh an entire column's format.
I refreshed the column by doing the following:
Select the entire column
Format the column as necessary
Go to the Data ribbon and select 'Text-to-Columns'
Ensure Delimited is selected, click Next
Uncheck all the Delimiters, click Next, then Finish

Using Vlookup to copy and paste data into a separate worksheet using VBA

Alright I'm a beginner with VBA so I need some help. Assuming this is very basic, but here are the steps I am looking at for the code:
-Use Vlookup to find the value "Rec" in column C of Sheet1, and select that row's corresponding value in column D
-Then copy that value from column D in Sheet1 and paste it into the first blank cell in column B of another worksheet titled Sheet2
I've got a basic code that uses Vlookup to find Rec as well as it's corresponding value in column D, then display a msg. The code works fine, and is the following:
Sub BasicFindGSV()
Dim movement_type_code As Variant
Dim total_gsv As Variant
movement_type_code = "Rec"
total_gsv = Application.WorksheetFunction.VLookup(movement_type_code,Sheet1.Range("C2:H25"), 2, False)
MsgBox "GSV is :$" & total_gsv
End Sub
I also have another one that will find the next blank cell in column B Sheet2, it works as well:
Sub SelectFirstBlankCell()
Dim Sheet2 As Worksheet
Set Sheet2 = ActiveSheet
For Each cell In Sheet2.Columns(2).Cells
If IsEmpty(cell) = True Then cell.Select: Exit For
Next cell
End Sub
Not sure how to integrate the two, and I'm not sure how to make the code paste the Vlookup result in Sheet2. Any help would be greatly appreciated, thanks!
So for being a beginner you're off to a good start by designing two separate subroutines that you can confirm work and then integrating. That's the basic approach that will save you headache after headache when things get more complicated. So to answer your direct question on how to integrate the two, I'd recommend doing something like this
Sub BasicFindGSV()
Dim movement_type_code As Variant
Dim total_gsv As Variant
movement_type_code = "Rec"
total_gsv = Application.WorksheetFunction.VLookup(movement_type_code, Sheet1.Range("C2:H25"), 2, False)
AssignValueToBlankCell (total_gsv)
End Sub
Sub AssignValueToBlankCell(ByVal v As Variant)
Dim Sheet2 As Worksheet
Set Sheet2 = ActiveSheet
For Each cell In Sheet2.Columns(2).Cells
If IsEmpty(cell) = True Then cell.Value2 = v
Next cell
End Sub
That being said, as Macro Man points out, you can knock out the exact same functionality your asking for with a one liner. Keeping the operational steps separate (so actually a two liner now) would look like this.
Sub FindGSV()
AssignValueToBlankCell WorksheetFunction.VLookup("Rec", Sheet1.Range("C2:H25"), 2, False)
End Sub
Sub AssignValueToBlankCell(ByVal v As Variant)
Sheet3.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value2 = v
End Sub
Like I said, if you plan to continue development with this, it's usually a good idea to design your code with independent operations the way you already have begun to. You can build off of this by passing worksheets, ranges, columns, or other useful parameters as arguments to a predefined task or subroutine.
Also, notice that I use Value2 instead of Value. I notice you're retrieving a currency value, so there's actually a small difference between the two. Value2 gives you the more accurate number behind a currency formatted value (although probably unnecessary) and is also faster (although probably negligible in this case). Just something to be aware of though.
Also, I noticed your use of worksheet objects kind of strange, so I thought it'd help to mentioned that you can select a worksheet object by it's object name, it's name property (with sheets() or worksheets()), index number (with sheets() or worksheets()), or the "Active" prefix. It's important to note that what you're doing in your one subroutine is reassigning the reference of the Sheet2 object to your active sheet, which means it may end up being any sheet. This demonstrates the issue:
Sub SheetSelectDemo()
Dim Sheet2 As Worksheet
Set Sheet2 = Sheets(1)
MsgBox "The sheet object named Sheet2 has a name property equal to " & Worksheets(Sheet2.Name).Name & " and has an index of " & Worksheets(Sheet2.Index).Index & "."
End Sub
You can view and change the name of a sheet object, as well as it's name property (which is different) here...
The name property is what you see and change in the worksheet tab in Excel, but once again this is not the same as the object name. You can also change these things programmatically.
Try this:
Sub MacroMan()
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
WorksheetFunction.VLookup("Rec", Sheet1.Range("C2:H25"), 2, False)
End Sub
The Range("B" & Rows.Count).End(xlUp) command is the equivalent of going to the last cell in column B and pressing Ctrl + ↑
We then use .Offset(1, 0) to get the cell after this (the next blank one) and write the value of your vlookup directly into this cell.
If Both work, then good, you have two working subs and you want to integrate them. You probably want to keep them so they might be useful for some other work later. Integrating them means invoking them in some third routine.
For many reasons, it is surely better and advised to avoid as much as possible to use (select, copy, paste) in VBA, and to use rather a direct copying method (range1.copy range2).
You need to make your routines as functions that return ranges objects, then in some third routine, invoke them
Function total_gsv() as range
Dim movement_type_code As Variant: movement_type_code = "Rec"
Set total_gsv = Application.WorksheetFunction.VLookup(movement_type_code,Sheet1.Range("C2:H25"), 2, False)
End Sub
Function FindFirstBlankCell() as Range
Dim Sheet2 As Worksheet: Set Sheet2 = ActiveSheet
For Each cell In Sheet2.Columns(2).Cells
If IsEmpty(cell) Then Set FindFirstBlankCell= cell: exit For
Next cell
End Sub
Sub FindAndMoveGsv()
total_gsv.copy FindFirstBlankCell
... 'some other work
End Sub

Determine number of columns in printed page

In Excel 2007, I have a worksheet that only contains data in a only few cells (well within one page wide/tall). For illustration, say the worksheet only contains data in cell A1. How can I use VBA to determine the number of columns that fit in a single printed page? Said another way, how can I determine the column furthest to the right in which I could add data and NOT cause an additional sheet to print. A couple of additional comments:
I am not setting a print area. If I were, then I'd just use the same
range...but I'm not.
I can't use UsedRange, because the used range is much smaller than
what actually fits in the width/height of a printed page.
I can't use ActiveWindow.VisibleRange because it isn't limited to a
single page width/height.
I've searched and searched, but cannot find a solution to accomplish this seemingly simple task. I mostly found scenarios that involved UsedRange, VisibleRange, and the print area, but those don't help me.
EDIT
Here's the final version of the function I'm using, which is a slight tweak of the selected answer.
Public Function GetLastColumnBeforeVPageBreak( _
ByRef ws As Worksheet, _
ByVal aVPageBreakNum As Long) As Long
Dim isMod As Boolean
isMod = False
On Error GoTo ErrorHandler
GetLastColumnBeforeVPageBreak = ws.VPageBreaks(aVPageBreakNum).Location.Column - 1
' If necessary, delete the last column with dummy data and reset UsedRange.
If isMod Then
ws.Cells(ws.Rows.Count, ws.Columns.Count).EntireColumn.Delete
r = ws.UsedRange.Rows.Count
End If
Exit Function
ErrorHandler:
If Err.Number = 9 Then
' Subscript out of range.
' Ensure there is more than one page by putting something in last cell.
isMod = True
ws.Cells(ws.Rows.Count, ws.Columns.Count).Value = 1
Err.Clear
Resume
Else
Err.Raise Err.Number
End If
End Function
I was sure there was a worksheet property around page breaks so I hit F2 in the IDE to open the object browser and searched on pagebreak. A little bit of F1'ing showed there is a Worksheets(1).VPageBreaks(1).Location property that returns a range object. The left side of the range aligns with the 1st vertical page break so:
LastColOnP1 = Worksheets(1).VPageBreaks(1).Location.Column - 1
will give you a variable containing the number of the last column that will print on page 1 of your 1st sheet.
Or within a procedure:
Sub FindFirstVPageBreak()
Dim LastColOnP1 As Long
With ActiveSheet
'Ensure there is more than one page by puting something in last column
.Cells(1, .Columns.Count) = 1
LastColOnP1 = .VPageBreaks(1).Location.Column - 1
'Delete the last column to allow UsedRange to be reset
.Cells(1, .Columns.Count).EntireColumn.Delete
End With
'Save to workbook to commit the reset UsedRange
If Not ActiveWorkbook.ReadOnly Then
ActiveWorkbook.Save 'assumes workbook has been saved previously.
End If
End Sub
You can use Columns(x).ColumnWidth to calculate (iif column contains data). See http://EzineArticles.com/7305778 for a much more detailed solution.

Why do Excel sheets have to be activated before selection?

This code
Sheets(1).Activate
Sheets(2).Range("A1").Select
will fail in VBA because you can only use Select on an object which is Active. I understand this is the case.
What element of the Excel datamodel causes this to be the case? I would think there is an implicit intent from a user/coder to Activate any object immediately prior to using Select - I do not understand why VBA would not make this assumption, and, I am assuming there is a reason this distinction exists.
What part of Excel's datamodel prevents selection without activation?
As brettdj pointed out, you do not have to activate the sheet in order to select a range. Here's a reference with a surprisingly large amount of examples for selecting cells/ranges.
Now as for the why do I have to active the sheet first? I do not believe it is a fault of the datamodel, but simply a limitation of the select method for Ranges.
From experimentation, it looks like there are two requirements to select a range in Excel.
Excel must be able to update the UI to indicate what is selected.
The ranges parent (I.E. the sheet) must be active.
To support this claim, you also cannot select a cell from a hidden sheet.
Sheets(1).Visible = False
Sheets(1).Activate
'The next line fails because the Range cannot be selected.
Sheets(1).Range("A1").Select
Simply put, when it comes to Ranges, you cannot select one you cannot see.
I would have claimed this is a limitation of select all together, except that you can actually select an object in a hidden sheet. Silly Excel.
I know that this is a bit late to the party, but I discovered a hack to do this...
Try this code:
Sheets(1).Activate
Sheets(2).Range("A1").Copy
Sheets(2).Range("A1").PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
Note that it is a hack, but it does the trick!!
#Daniel Cook: thanks for your response, but unfortunately Excel itself doesn't play by the same rules imposed on Excel Macros...
To illustrate, I'll briefly present my current problem...
I'm attempting to re-set a table's contents to a common state. This method will be applied to multiple tables across various sheets:
Public Sub restoreTable()
Dim myTableSheet As Worksheet: Set myTableSheet = Range("Table1").Parent
Dim myTable As ListObject: Set myTable = myTableSheet.ListObjects("Table1")
' --- Clear Table's Filter(s)
If myTable.ShowAutoFilter Then ' table has auto-filters enabled
Call myTable.Range.AutoFilter ' disables autofilter
End If
myTable.Range.AutoFilter ' re-apply autofilter
' --- Sort by Sequence number
Call myTable.Sort.SortFields.Clear ' if not cleared, sorting will not take effect
myTable.Sort. _
SortFields.Add Key:=Range("Table1[[#Headers],[#Data],[Column1]]"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
myTable.Sort.Header = xlYes
myTable.Sort.Orientation = xlTopToBottom
myTable.Sort.SortMethod = xlPinYin
Call myTable.Sort.Apply
myTable.Sort.SortFields.Clear
End Sub
For each use-case below, Table1 is found in Sheet1
Use-Case 1:
Activate Sheet1, select range A1
Run restoreTable
observe: range Sheet1 A1 remains selected
Use-Case 2:
Activate Sheet1, select range A1
Activate Sheet2
Run restoreTable
observe: range Sheet1 A1 is not selected, instead the range Table1[#Data] is selected
Solution
It's absolutely terrible, but this is the best solution I could find
Public Sub resotreTable_preserveSelection()
Dim curSheet As Worksheet: Set curSheet = ActiveSheet
Dim tableSheet As Worksheet: Set tableSheet = Range("Table1").Parent
' Change Sheet
tableSheet.Activate
' Remember Selection / Active Ranges
Dim originalSelection As Range: Set originalSelection = Selection
Dim originalActiveCell As Range: Set originalActiveCell = ActiveCell
' Restore Table
Call restoreTable
' Restore Old Selection
originalSelection.Select
originalActiveCell.Activate
' Change Back to old sheet
curSheet.Activate
End Sub
Note: in this case, the original* ranges are not necessary, but you get the point: you can buffer the original selection and restore it when you're finished
I really don't like excel
Of course you don't have to select or activate the sheet to select/activate the cell. My way is to use "On Error Resume Next" and "On Error GoTo 0". Code below selects first cell in every worksheet of a workbook without selecting it. The worksheets are even very hidden on this stage.
On Error Resume Next
For i_wks = 1 To wb_macro.Worksheets.Count
wb_macro.Worksheets(i_wks).Cells(1).Select
Next i_wks
On Error GoTo 0

Referring to Dynamic Named Ranges in VBA

I'm having troubling referring to a Dynamic Name Range in VBA.
My ranges are defined as
=OFFSET(Sheet!$B$2,0,0,COUNTA(Sheet!$B:$B)-1,1)
My code should search one range for all entries in another range, the intention being that any missing entries will be added. So far I have
Sub UpdateSummary()
Dim Cell As Range
Dim rngF As Range
Set rngF = Nothing
' Step through each cell in data range
For Each Cell In Worksheets("Aspect").Range("A_Date")
' search Summary range for current cell value
Set rngF = Worksheets("Summary").Range("Sum_Date").Find(Cell.Value) // Does not work
If rngF Is Nothing Then
' Add date to Summary
End If
Set rngF = Nothing
Next Cell
End Sub
The For loop seems to work ok. However, using the .Find method is giving me an error message.
Application-defined or object-defined error
It does work if I replace the named range with a specific range ($B$2:$B$5000), so it seems to be down to how the named range is being passed.
Any ideas would be appreciated.
Thanks.
The error is almost definitely because Excel can't find a named range Sum_Date that refers to a range on a worksheet named Summary. The most common causes are
Sum_Date refers to a sheet other than Summary. Check the RefersTo property of Sum_Date and make sure nothing is misspelled.
There is not a named range Sum_Date, that is, it's misspelled in the VBA code. Check the spelling of the named range in the Name Manager.
There is an error in the RefersTo formula of Sum_Date. It sounds like you already verified that this isn't the case.
I've had the a similar if not the same problem & here's how I solved it:
I first realized that the method I used to create my named range, using the Name Manager, my named range had a scope of Workbook. This is important because, it doesn't belong to the worksheet, & therefore will not be found there.
So, Worksheets("Summary").Range("Sum_Date") would not work for me.
Since my range belonged to the workbook, the way I was able to find is to use ActiveWorkbook.Names("Sum_Date")
For me I used it to remove the formula from named range that I am using in many places. The huge advantage is that named range is updated only once instead of the formula being called for every cell location that ranged is called. Huge time delay difference!
Public last_Selection As String
Private Sub Worksheet_Change(ByVal Target As Range)
'excel data change detection
If Range(last_Selection).Column = 2 Then
'Disable events, so this only executes once
Application.EnableEvents = False
'This can be done with a complex formula in a cell,
'but this is easily understood
Range("B1").End(xlDown).Select
ActiveWorkbook.Names("last_Entry").Value = ActiveCell.Row
'Re-enable so this routine will execute on the next change
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'constantly store the last cell to know which one was previously edited
last_Selection = Target.Address
End Sub
I know this is a very old thread, but I had the same issue today and I was looking for solution for quite a long time. So maybe this will help someone.
The named "range" defined by the =OFFSET(...) formula is actually a named FORMULA, so in VBA you have to evaluate it first to get the range. E.g.:
Set rgNamedRange = Worksheets("Summary").Evaluate("Sum_Date")
Credits to a guy named "shg" from mrexcel.com, who got me on right track. :)
I have been experimenting with this for a few days and eventually I came up with the following. It may not be the most efficient but it did work for me!
The named range of "OhDear" was set up in the normal way
Dim vItem As Variant
Set vItem = Names("OhDear")
Debug.Print vItem.Name
Worth a try don't you think!
This does not work if instead of using a variant you use something like: Dim Nm as Name: Set Nm = Names("OhDear"). Any variations using 'Nm' failed!!!