I have an Excel workbook, and in that workbook I have a number of sheets.
One is called main and the other sheet data which holds all the information. The data sheet has people's name and assigned numbers in the same cell.
e.g.: A2 would have: 123 Chris Smith
What I am trying to achieve is for a user to start typing the number anywhere in the main sheet that it scans the data sheet and completes the rest of the data.
So a user would type 123 and the macro would then fill out the rest 123 Chris Smith.
As already mentioned you can use the Worksheet_Change() Event. To Show you how it works, put this code in the main sheet in the editor. Now type any number that matches your data list and click out of the cell, it will be now completed.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sht As Worksheet
Dim rng As Range
Dim val As Variant: val = Target.Value
Set sht = Worksheets("Data")
If Not IsError(val) And Not IsArray(val) Then
If val <> "" Then
Set rng = sht.Range("A:A").Find(val & "*", LookAt:=xlWhole)
If Not rng Is Nothing Then
Application.EnableEvents = False
Target.Value = rng.Value
Application.EnableEvents = True
End If
End If
End If
End Sub
Related
I was asked to do this specifically not in the sheet itself within the cell.
I need a constantly running Macro so that when I put an ID number in cell D9 in sheet 1, various other cells in Sheet 1 get populated by data points in a table in Sheet 2.
I have the following:
Also, Excel is crashing constantly doing this, but my instruction is specifically to use VBA and not use normal lookups in the cell.
Tried setting it to general and other things. very new to VBA sorry
Private Sub Worksheet_Change(byVal Target As Range)
Dim ID As String
Dim LookupRange As Range
Set LookupRange = Sheet3.Range("A13:AN200")
Dim DataValue As String
If Sheets("Template").Range("D9").Value <> "" Then
ID = Sheets("Template").Range("D9")
DataValue = Application.WorksheetFunction.Vlookup(ID, LookupRange, 3, False)
Range("D11").Value = DataValue
End if
End
I reviewed your code and made some changes that should allow it to work. I have commented most of what I did. If you have questions please let me know.
Disclaimer: This is untested. So you will want to verify it before actually using it.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Dim ws As Worksheet
Dim ws3 As Worksheet
Dim wsName As String
Dim IDRange As String
Dim ResultRange As String
Dim vLookUpRange As String
Dim ID As String
Dim LookupRange As Range
Dim DataValue As String
wsName = "Template"
IDRange = "D9"
ResultRange = "D11"
vLookUpRange = "A13:AN200"
'This is just a habbit of mine, I always set sheets to their own variables.
'It is just easier for me to work with
Set wb = ActiveWorkbook
Set ws = wb.Worksheets(wsName)
Set ws3 = wb.Worksheets(3)
'This line (moved from below Dim) was not writen correctly. it is not Sheet3 but sheets(3) As you can see I moved
'the sheet definition to above. (Again a habbit of mine)
Set LookupRange = ws3.Range(vLookUpRange)
'This is not needed but I add it when I am working with changes to sheets so that I only run the code I want
'when it is within the rang I am looking for. You could add logic to make sure that you only run the code if
'you are only modifying that spesific cell. But for your goal, I don't think it is needed.
If Not Intersect(Target, ws.Range(IDRange)) Is Nothing Then
'You can use .Value but .Value2 is slightly faster with very few consequences.
'eg if you ever need to read or write large amounts of data it will save you some time.
If ws.Range(IDRange).Value2 <> "" Then
ID = ws.Range(IDRange)
DataValue = Application.WorksheetFunction.VLookup(ID, LookupRange, 3, False)
'You also need to specify a sheet for this. Since this is located in the sheet you are entering
'data I assumed the sheet "template"
ws.Range(ResultRange).Value = DataValue
End If
End If
End Sub
I have a conditional formatting rule defined as macro, which deletes the old rules and replaces them with updates ones:
Sub setCondFormat()
Set Table = ActiveSheet.ListObjects("Rules")
Table.Range.FormatConditions.Delete
Set Attribute = Table.ListColumns("Attribute")
With Attribute.DataBodyRange.FormatConditions _
.Add(xlExpression, xlEqual, "=ISEMPTY(A2)")
With .Interior
.ColorIndex = 0
End With
End With
End Sub
The conditional formatting in Excel needs to be updated. Otherwise the
cell ranges in the rules get fragmented.
Let's say you have two rules:
Make $A$1:$A$30 red
Make $B$1:$B$30 blue Now select A10:B10 and copy/paste that to A20:B20.
What Excel will do is to delete the conditional formatting.
For A20:B20 from the rules that applied to those cells and add new
rules that have the formatting for A20:B20. You end up with four
rules:
Make =$A$20 red
Make =$B$20 blue
Make =$A$1:$A$19,$A$21:$A$30 red
Make =$B$1:$B$19,$B$21:$B$30 blue
This happens, when the table structure gets changed through cut/paste/delete/insert events.
How to trigger the above VBA macro on cut/paste/delete/insert events?
You could use a shortcut for your macro
VBA event trigger on copy?
If you don't want to go this way you'll need to use the Windows API:
Is there any event that fires when keys are pressed when editing a cell?
The solution I found is create a new Sheet with the content of your table when you open the Workbook. First you need to create a Module with the Public Variables.
Public OldRange As Range
Public NewRange As Range
Public Table As ListObject
Then, use the event Open of your Workbook.
Private Sub Workbook_Open()
Dim sh As Worksheet
Dim address As String
For Each sh In Worksheets
If sh.Name = "DATA" Then
Worksheets("DATA").Activate
ActiveSheet.Delete
End If
Next
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "DATA"
Set sh = ActiveWorkbook.Sheets("Plan1")
sh.Activate
Set Table = ActiveSheet.ListObjects("Rules")
Set OldRange = Table.Range
address = Table.Range.address
Table.Range.Copy
Set sh = ActiveWorkbook.Sheets("DATA")
sh.Activate
Range(address).PasteSpecial (xlPasteAll)
End Sub
And then, use the event Worksheet_Change to verify the content of your original table with the earlier saved table.
Private Sub Worksheet_Change(ByVal Target As Range)
Set Table = ActiveSheet.ListObjects("Rules")
If Intersect(Target, Table.Range) Is Nothing Then Exit Sub 'this will guarantee that the change made in your sheet is in your desired table
Set NewRange = Table.Range
Dim rng As Range
Dim rngaddr As String
Dim TableChanged As Boolean
TableChanged = False
For Each rng In NewRange
rngaddr = rng.address
If rng.Value <> ActiveWorkbook.Sheets("DATA").Range(rngaddr).Value Then
'do something
TableChanged = True
End If
Next
End Sub
Remember: you need to save the content of your table every time you changed it.
My workbook consists of 2 sheets: Sheet1 is the primary dashboard that the user sees, while Sheet2 consists of a pivot table and regular table.
I'd like to implement some VBA code so that the user can click on some text in Sheet1 and the pivot table on Sheet2 will filter according to what text the user clicked on.
So for instance, Column A on Sheet1 is a list of US Cities. I'd like the user to be able to double click on a city name in Sheet1 and have the pivot table on Sheet2 filter to whatever the city name was clicked on.
I don't need the macro to actually bring the user to Sheet2.
All I'm planning on doing is just referencing the pivot table on Sheet1.
I designed something similar using a standard table, but I really need this to work on the Pivot Table and I'm not sure how to go about it.
UPDATE
Ok so here is my code now:
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("E:P")) Is Nothing Then
Application.ScreenUpdating = False
Worksheets("Dillon Pivot").PivotTables("PivotTable2").ManualUpdate = True
Worksheets("Dillon Pivot").PivotTables("PivotTable2").PivotFields("Match").ClearAllFilters
Worksheets("Dillon Pivot").PivotTables("PivotTable2").PivotFields("Match").CurrentPage = ActiveCell.Value
Worksheets("Dillon Pivot").PivotTables("PivotTable2").ManualUpdate = False
Application.ScreenUpdating = True
End If
End Sub
I want the user to be able to click a cell on the main dashboard and have the pivot table on "Dillon Pivot" be filtered.
However, when I double click a cell I get the following error: "Application-defined or object defined error"
Can anyone assist?
Add the piece of code below to your "Sheet1" events.
The code inside the Intersect is triggered, only if the cell that was double-clicked is inside Column A (until last row that has a name of a city inside).
I use a variable Dim PvtTbl As PivotTable to set the "PivotTable2" in "Dillon Pivot" sheet - it makes the code much shorter and easier to understand.
Code
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim LastRow As Long
Dim PvtTbl As PivotTable
' find last row in Column A that has a city
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
' check if double-click was inside a range in Column A, where there is a city name
' starting from row 2, assuming the first row is the header row
If Not Intersect(Target, Range("A2:A" & LastRow)) Is Nothing Then
Application.ScreenUpdating = False
Set PvtTbl = Worksheets("Dillon Pivot").PivotTables("PivotTable2")
With PvtTbl
.ManualUpdate = True
.PivotFields("Match").ClearAllFilters
.PivotFields("Match").CurrentPage = Target.Value
.ManualUpdate = False
End With
Application.ScreenUpdating = True
End If
End Sub
Essentially I'm creating a tracking sheet which will have a cell on it that, when clicked, will create a new excel sheet in the same workbook. For testing purposes I'm currently just having it create a new sheet, but eventually I'll have a sheet that it'll copy. What I need help with is, how do I get VB to pull a cell value to use as the name of the new/copied sheet? Here's the scenario:
Each row will have a Client column (which is Column C) which I want to use for the names of the workbooks that will be created. I'm trying to have a cell (say column R in that row) that when clicked creates a new worksheet and pulls in the value of column C in that row as the worksheet's name.
So, say Row 5 has "Test Client" in C5. When R5 is clicked, I want it to create a sheet that is named "Test Client". I've seen solutions that use loops to go through the column and create a sheet for each, but that wouldn't really work for my scenario as I'd need them to be created on the fly and not always for each row.
I know how to create the sheets in vb but my issue is getting the name. Is there a way to get vba to pull the name from column C for the row in which it was activated? So if it was activated for Row 5, it pulls C5, if it was Row 10, it pulls C10 etc.
Any suggestions would be greatly appreciated, I'm currently using this to create the sheets:
Sub CreateSheet()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
End Sub
and this to call:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row > 5 And Target.Column = 18 And Target.Count = 1 Then Call CreateSheet
End Sub
The code below reads the value in Column C for the relevant row, and then passes it as a String to your Function:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 5 And Target.Column = 18 And Target.Count = 1 Then
Dim ShtName As String
ShtName = Cells(Target.Row, "C").Value
Call CreateSheet(ShtName)
End If
End Sub
This is your function, I've added a String that is passed representing the worksheet name:
Public Sub CreateSheet(ws_Name As String)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = ws_Name
End Sub
Update: As Shai Rado pointed out I was missing an error handler.
You should test to see if the worksheet exists first. This pattern will make it easier to debug and add functionality to your code.
Worksheet Module
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws As Worksheet
Dim WorksheetName As String
If Target.Row > 5 And Target.Column = 18 And Target.Count = 1 Then
WorksheetName = Cells(Target.Row, "C").Value
Set ws = getWorkSheet(WorksheetName)
If Not ws Is Nothing Then Set ws = getNewWorkSheet(WorksheetName)
End If
End Sub
Standard Module
Function getWorkSheet(WorksheetName As String, Optional WorkbookName As String) As Worksheet
If Len(WorkbookName) = 0 Then WorkbookName = ThisWorkbook.Name
With Workbooks(WorkbookName)
On Error Resume Next
Set getWorkSheet = .Worksheets(WorksheetName)
On Error GoTo 0
End With
End Function
Function getNewWorkSheet(WorksheetName As String, Optional WorkbookName As String) As Worksheet
Dim ws As Worksheet
If Len(WorkbookName) = 0 Then WorkbookName = ThisWorkbook.Name
With Workbooks(WorkbookName)
Set ws = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
On Error Resume Next
ws.Name = WorksheetName
If Err.Number = 0 Then
Set getNewWorkSheet = ws
Else
ws.Delete
End If
On Error GoTo 0
End With
End Function
In my active sheet called Report I have 2 column I & F.
It has repeating cells containing text "Grand Total".
I would like to delete whole row if it contains Grand Total automatically.
VBA code would be nice.
With the following VBA code, you can quickly delete the rows with certain cell value, please do as the following steps:
Select the range that you want to delete the specific row.
Click Developer>Visual Basic, a new Microsoft Visual Basic for applications window will be displayed, click Insert > Module, and input the following code into the Module:
VBA code to Remove entire rows based on cell value(i.e. Grand Total):
Sub Delete_Rows()
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("A1:D22"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) = "Grand Total" _
Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub
Then click "Play/Run" button to run the code, and the rows which have certain value have been removed.
(Note: If you can't see Developer Tab in Excel Do these Steps: 1)Click the Office Button, and then click Excel Options. 2)In the Popular category, under Top options for working with Excel, select the Show Developer tab in the Ribbon check box, and then click OK.)
Using AutoFilter is very efficient. This can also be done without VBA (ie manually)
Main Sub
Sub Main()
Dim ws As Worksheet
Dim rng1 As Range
Dim StrIn As String
Dim rng2 As Range
Set ws = Sheets("Sheet1")
Application.ScreenUpdating = False
Set rng1 = ws.Range("F:F,I:I")
StrIn = "Grand Total"
For Each rng2 In rng1.Columns
Call FilterCull(rng2, StrIn)
Next
Application.ScreenUpdating = True
End Sub
Delete Sub
Sub FilterCull(ByVal rng2, ByVal StrIn)
With rng2
.Parent.AutoFilterMode = False
.AutoFilter Field:=1, Criteria1:=StrIn
.EntireRow.Delete
.Parent.AutoFilterMode = False
End With
End Sub
This should help get you started.
http://msdn.microsoft.com/en-us/library/office/ee814737%28v=office.14%29.aspx#odc_Office14_ta_GettingStartedWithVBAInExcel2010_VBAProgramming101
Also see similar question:
Delete a row in Excel VBA