VBA Passing cells/range of cells to multiple subs - vba

Hi i have a problem defining a range of cells as a variable depending on what group of cells have changed. So far I have this but it sends up multiple errors, I have tried passing them as string and creating temp variables to hold the values and pass that but no matter what it does not seem to work.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Application.Intersect(Worksheets("Sheet1").Range("A:E"), Target) Is Nothing) Then
DoSort("A3:F100", "A4")
End If
If Not (Application.Intersect(Worksheets("Sheet1").Range("H:L"), Target) Is Nothing) Then
DoSort("H3:M100", "H4)
End If
End Sub
Sub DoSort(x As Range, y As Range)
With ThisWorkbook.Sheets("Sheet1")
.Range(x).Sort Key1:=.Range(y), Order1:=xlAscending, Header:=xlYes
End With
End Sub
I had it working before when i hard coded the cells in like this:
Private Sub DoSort2()
With ThisWorkbook.Sheets("Sheet1")
.Range("H3:M100").Sort Key1:=.Range("H4"), Order1:=xlAscending, Header:=xlYes
End With
End Sub
Never really worked in VBA with excel macros so am very new to this, so any help would be appreciated!

See my refactored code below. See my comments for explanation.
Private Sub Worksheet_Change(ByVal Target As Range)
'I used "Me." in place of "Worksheets("Sheet1")." assuming that the Worksheet_Change event is already on Sheet1
If Not Intersect(Me.Range("A:E"), Target) Is Nothing Then
DoSort "A3:F100", "A4"
End If
If Not Intersect(Me.Range("H:L"), Target) Is Nothing Then
DoSort "H3:M100", "H4" 'you were missing a close " here
End If
End Sub
'define x and y as String to pass the string address of the range reference
Sub DoSort(x As String, y As String)
With ThisWorkbook.Sheets("Sheet1")
.Range(x).Sort Key1:=.Range(y), Order1:=xlAscending, Header:=xlYes
End With
End Sub
You could pass the range if you want as well. That would look like this:
DoSort Me.Range("A3:F100"), Me.Range("A4")
Sub DoSort(x as Range, y as Range)
x.Sort Key1:=y, Order1:=xlAscending, Header:=xlYes
End Sub

You could pass the data as a String versus as a Range:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Application.Intersect(Worksheets("Sheet1").Range("A:E"), Target) Is Nothing) Then
DoSort("A3:F100", "A4")
End If
If Not (Application.Intersect(Worksheets("Sheet1").Range("H:L"), Target) Is Nothing) Then
DoSort("H3:M100", "H4")
End If
End Sub
Sub DoSort(x As String, y As String)
With ThisWorkbook.Sheets("Sheet1")
.Range(x).Sort Key1:=.Range(y), Order1:=xlAscending, Header:=xlYes
End With
End Sub

Related

Limiting the code to run only when within a specific cell range

I'm trying to make a Spin Button that will edit the active cell, but only when it is within a specific cell range. I want the code to start up if the active cell is within the range of Sheet 1 cells J63:J97 and, not run if it is outside that range.
This is the code I have so far. It will edit the active cell, as needed. However, it is not limited to the range I need it to be.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
SpinButton1.Value = Selection.Value
End Sub
Private Sub SpinButton1_Change()
Selection.Value = SpinButton1.Value
End Sub
Try using Application.Intersect.
I have defined a separate Function to do the job.
This code is tested and it works:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If checkIntersection(Target, Range("J63:J97")) Then
SpinButton1.Value = Selection.Value
End If
End Sub
Private Sub SpinButton1_Change()
If checkIntersection(Selection, Range("J63:J97")) Then
Selection.Value = SpinButton1.Value
End If
End Sub
'Check if Range1 and Range2 are intersecting
Function checkIntersection(range1 As Range, range2 As Range) As Boolean
checkIntersection = Not Application.Intersect(range1, range2) Is Nothing
End Function
may check selection with Intersect
Private Sub SpinButton1_Change()
If Not Intersect(Selection, Range("J63:J97")) Is Nothing Then
Selection.Value = SpinButton1.Value
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("J63:J97")) Is Nothing Then
SpinButton1.Value = Selection.Value
End If
End Sub

VBA: How to automatically trigger macro without a button

I have made a macro that auto fill the formula on sheet1 whenever the row number of sheet2 is changed.
Is it possible to trigger it automatically without a button when i have any update on sheet2?
Sub Autofill()
Dim sg As Sheets
Dim Row As Long
Dim fillRow As Integer
Application.EnableEvents = False
Row = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
fillRow = Row - 1
Sheets("Sheet1").Select
Range("A1:E1").Select
Selection.Autofill Destination:=Range("A1:E" & fillRow), Type:=xlFillDefault
Application.EnableEvents = True
End Sub
You could try to create a sub like following:
Paste the following code. And change:
1) "D4" with your cells you want to "monitor"
2) Paste your macro in the line "Do things"
The problem is, your code is run everytime the focus is changed to another cell.
But you could also use Worksheet_BeforeDoubleclick if this is enough. Then every time you clicke twice the code will run
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("D4")) Is Nothing Then
'Do things
End If
End If
End Sub
Right-click on the sheet tab at the bottom of the scree, click 'view
code' then insert this following code in there.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Row As Long
Dim fillRow As Integer
This next line will exit the code if column A is not what is being
changed on the sheet. Delete it if you want the code to be triggered
by any change on any cell of the sheet.
if InRange(Target,Worksheets("Sheet2").range("A:A") = false then exit sub
Row = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
fillRow = Row - 1
Sheets("Sheet1").Select
Range("A1:E1").Select
Selection.Autofill Destination:=Range("A1:E" & fillRow), Type:=xlFillDefault
End Sub
Function InRange(Range1 As Range, Range2 As Range) As Boolean
InRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
End Function
use a Worksheet.SelectionChange-Event.
in the Worksheet-VBA for sheet2 add:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Autofill()
End Sub
(This will be triggered if cell is changed, even if user does not leave the row, so check parameter Target.)

Multiple cell value change to trigger macros

I have different set of values in cells G3:G4 and D15:D10000 in a single sheet. I want run two separate codes when G columns or D columns are changed. How I can identify which set of columns are changed?
out this in your worksheet code pane
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G3:G4")) Is Nothing Then
'code when some cell in range "G3:G4" is changed
ElseIf Not Intersect(Target, Range("D15:D10000")) Is Nothing Then
'code when some cell in range "D15:D10000" is changed
End If
End Sub
Put the code below in your relevant worksheet, in the Worksheet_Change event.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim IntersectRange As Range
Set WatchRange = Application.Union(Range("G3:G4"), Range("D15:D10000"))
Set IntersectRange = Intersect(Target, WatchRange)
If Not IntersectRange Is Nothing Then
Select Case Target.Column
Case 4 ' column D
Call A
Case 7 ' column G
Call B
End Select
End If
End Sub
Below are examples of Sub A and Sub B:
Sub A()
MsgBox "Running Sub A"
End Sub
Sub B()
MsgBox "Running Sub B"
End Sub

How do I improve my short VBA code as below?

I tried to protect cells on my workbook from being edited. I wrote this code,
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End Sub
But after some tests, I caught an exception. If I cut a cell and paste to another cell, it's ALLOWED! I'm not sure if there are other exceptions like this that I haven't figured out. My question is how do I protect cells being edited but meanwhile able to be copied?
Use the interface only option, this allows the sheet to be locked - but only for user interactions. Any code can interact with the sheet without being blocked:
Private Sub Workbook_Open()
For Each ws In ThisWorkbook.Sheets
ws.Protect UserInterfaceOnly:=True
Next
End Sub
without protecting the sheets the only solution I can think of is:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Application.CutCopyMode = 2 Then Application.CutCopyMode = 0
End Sub
Should be self-explaining ;)
or runn all sheets like:
Sub protectAllSheets()
Dim x As Variant
For Each x In ThisWorkbook.Sheets
x.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Next
End Sub

Highlight current Selection in Yellow

I simply want the selected range to be yellow, and to return to colorless when it is de-selected. The code is the following:
Option Explicit
Public previouscell As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Selection.Interior.Color = vbYellow
previouscell.Interior.ColorIndex = xlNone
Set previouscell = Selection
End Sub
The problem is setting previouscell in the first place. I tried putting it in Worksheet_Activate(), but it wouldn't work as soon as I opened the workbook (only when I changed the sheet, it would work great after that.)
So I tried declaring it as a public in ThisWorkbook.Workbook_open as well:
Option Explicit
Public previouscell As Range
Private Sub Workbook_Open()
Set previouscell = ActiveCell
ActiveCell.Interior.Color = vbYellow
End Sub
But it doesn't recognize the variable previouscell then, because I believe it is not transferred from ThisWorkbook (I did close and reopen the workbook before testing). Does anyone know what I need to change for this simple task?
(4th edit)
Use this workbook code, with your sheet code removed:
Option Explicit
Public previousCells As Range
Private Sub Workbook_Open()
SetSelectionYellow
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
SetSelectionYellow
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
SetSelectionYellow
End Sub
Private Sub SetSelectionYellow()
If Not previousCells Is Nothing Then previousCells.Interior.ColorIndex = xlNone
Set previousCells = Selection
previousCells.Interior.Color = vbYellow
End Sub
This seems to work if you place it in the code module of the sheet in question.
Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlNone
ActiveCell.Interior.Color = vbYellow
End Sub
You're on the right track with the first code block. Just test to see if previouscell has been set to anything, and if not, set it to the current selection (or whatever you want to do).
Option Explicit
Public previouscell As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If previouscell Is Nothing Then
Set previouscell = Selection
End If
Selection.Interior.Color = vbYellow
previouscell.Interior.ColorIndex = xlNone
Set previouscell = Selection
End Sub
In the ThisWorkbook.Workbook_Open sub, set previouscell to A1 (or some default cell that has no interior color). Then in the Worksheet_SelectionChange sub do your thing. You have everything correct, but you needed 2 parts:1) setting the initial default value for previouscell and 2) changing the interior of cells when the selection changes. You did part 2, but missed part 1.