Automate a macro based on a change within a range from another sheet - vba

I am trying to automate a macro to run on sheet2 whenever a cell within a range on sheet1 is changed. I have tried a bunch of things and I don't have the vba experience to know what is wrong with them. Basically, sheet1 has my input, and I assigned a level of priority 1-5 to each item. Sheet2 shows only those items ranked 1, 3, or 4. I did this with if statements, but this leaves a bunch of blank rows in my table, so I can sort the blank rows out using the filter function. If I change a ranking on sheet1, I want my sheet2 table to automatically update. I wrote a sort function which resorts my sheet2 data appropriately but I am struggling to automate it so that it updates automatically when anything from sheet1 is changed. So far I have been using worksheet_change and can get sheet1 to refilter when sheet1 is changed, which is not what I want. Any ideas?
This is my current sort function:
Sub ReSort()
With Worksheets("Sheet2")
.Range("$A$2:$D$34").AutoFilter Field:=2
.Range("$A$2:$D$34").AutoFilter Field:=2, Criteria1:="<>"
End With
End Sub

This:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
' Do something
End If
End Sub
Should do the trick

I finally got it to work! For those reading this and having a similar problem, I have this code saved in sheet1:
Sub ReSort()
'This function filters my table spanning A2:D34 by the second column and sorts out the blanks
With Worksheets("Sheet2")
.Range("$A$2:$D$34").AutoFilter Field:=2
.Range("$A$2:$D$34").AutoFilter Field:=2, Criteria1:="<>"
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'This function runs my ReSort function if any cell on sheet1 in E3:E34 or G3:G34 is changed
If Not Intersect(Target, Range("$E$3:$E$34,$G$3:$G$34")) Is Nothing Then
ReSort
End If
End Sub
Thanks to everyone for their help! I was seriously pulling my hair out in frustration with this.

Sounds like you're on the right path, worksheet_change is the correct way to go with this as you do want the macro to run when sheet1 is changed so you need to detect that.
I suspect you're just missing one thing, the macro that runs on sheet2, put it in a module reference sheet2 explicitly
For example,
Worksheets("Sheet1").Range("A1")
instead of just
Range("A1")
Then you can call the function to run from any sheet just by using the function name
If you need more detail, post all of the code you have so far and I will happily modify it to suit

Related

Mirroring Sheet1 to Sheet2 for Interior Color only, through VBA

I have a schedule showing a lot of information. I would like to condense this onto a second sheet that displays the fill color only and none of the values.
I want that any fill color changes are automatically copied from sheet1 to sheet2.
I want the code to work with a specific cell range as they differ from both sheets, (Sheet1 is "D8:QP27) & (Sheet2 is B3:QN22) and to get it to mirror at all.
Sheet1 showing all information
Sheet2 showing fill (Interior.Color)
It looks as if you also want to copy the borders (eg the diagonal border of column I), so I would suggest you use PasteSpecial with the option xlPasteFormats. See https://learn.microsoft.com/en-us/office/vba/api/excel.range.pastespecial
With ThisWorkbook
.Worksheets("Sheet1").Range("D8:QP27").Copy
.Worksheets("Sheet2").Range("B3:QN22").PasteSpecial xlPasteFormats
End With
Update: As you are looking for a trigger to copy the format automatically. First step is to create a subroutine:
Sub copyFormat()
Application.ScreenUpdating = False
With ThisWorkbook
.Worksheets("Sheet1").Range("D8:QP27").Copy
.Worksheets("Sheet2").Range("B3:QN22").PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub
Now you need to find a way to call the code, eg
o call the routine from the Worksheet_SelectionChange-event (drawback: as this is rather slow, it could annoy the user)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
copyFormat
End Sub
o Place a button on the sheet to call the routine.
o Use a Timer to call the routine every n seconds (see https://learn.microsoft.com/en-us/office/vba/api/excel.application.ontime). Plenty of examples on SO and elsewhere

How to trigger VBA Workbook_SheetCalculate Event?

I tried Workbook_SheetCalculate Event and tried to trigger it, but it did not work, although I recalculated the worksheet!
How to trigger this Event?
here is an example, in the worksheet for the event have the following code:
Private Sub Worksheet_Calculate()
MsgBox "Calculating"
End Sub
Then in the sheet, in any cell, enter =RAND()
The formula causes a recalculation and triggers the event.
Or from a standard module use the following:
Public Sub Test()
'Application.Calculate ''could use this event for the workbook
With Worksheets("Sheet5") 'sheet containing the event code
.Calculate
End With
End Sub
The key seems to be that there is something in the sheet to calculate e.g. =RAND().
I remembered from another post, at some point, a link to the following Excel’s Smart Recalculation Engine
A quick extract says:
Excel normally only calculates the minimum number of cells possible.
Excel’s smart recalculation engine normally minimises calculation
time by tracking changes and only recalculating
Cells, formulae, values or names that have changed or are flagged as needing recalculation.
Cells dependent on other cells, formulae, names or values that need recalculation.
So, if you just had constants in the sheet, even if you issue a Worksheet.Calculate the msgbox wouldn't appear. You could test this by removing the =RAND() from the sheet and just putting 1 in the cell.
If I have two sheets each with a single non-volatile formula, and this in the workbook module:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Debug.Print Sh.Name
End Sub
I see both sheets names on calling:
Application.CalculateFull
or:
Application.CalculateFullRebuild
but no output with:
Application.Calculate
If I add a volatile formula to one of the sheets then I get that sheet when calling Application.Calculate.
If you're still having problems then you'd need to post a few more details including your event code and what types of formulas you have on your sheets.

Copy and paste values and not formulas

Writing macro for the first time, I have to copy only cell values to another and which I got it working, however, I am not sure, how to copy entire column without specifying range since range may be different every time. Here, I am trying with a range which is working, but I want it to check values of cell for that column and until it finds a value copy/paste to the another column.
Here is the code I have so far:
Sub CopyingCellValues()
Range("E2:E7").Copy
Range("C2:C7").PasteSpecial xlPasteValues
End Sub
Thanks.
Simple Columns copy will be...
Sheets("Sheet Name").Columns(1).Copy Destination:=Sheets("Sheet Name").Columns(2)
Helpful info at MSDN on Getting Started with VBA in Excel 2010
Edit:
With out the formula, Try
Sub CopyingCellValues()
Range("E:E").Value = _
Range("C:C").Value
End Sub
Sub ValueToValue()
[E:E].Value = [C:C].Value
End Sub

copy row to next free row on another spreadsheet on change

First off, I'm a noob when it comes to Macros and VBA, so please forgive me if I don't make sense.
I've got an Excel spreadsheet which is basically a list of users and their mobile phone numbers and some other bits (columns A-K are currently used) and it's ordered by rows.
What I need is a way of copying the whole row if I change a cell. So if I change the username, it copies the whole row of that user to the next blank row on a second sheet.
The purpose of this is to keep an audit trail allowing us to see who's previously used a number etc.
I found this: Copy row to another sheet in excel using VBA which is working as intended, but I can't for the life of me get it to a, copy the cells to the next free row, or b, not overwrite the existing entry.
This is the code I'm using:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Range, rw As Range
For Each a In Selection.Areas
For Each rw In a.Rows
If rw.Row >= 2 Then
rw.EntireRow.Copy Sheet2.Cells(2 + (rw.Row - 2) * 3, 1)
End If
Next rw
Next a
End Sub
I'd really appreciate it if someone could help me customise it.
I'm using Excel 2010 on Win7.
Many thank in advance.
Typically the Intersect method is used to determine if the cell or cells receiving a change involve one or more columns that you are concerned with. You can add additional parameters; in this case, I've .Offset the Worksheet.UsedRange property down one row to make sure that row 1 is not involved.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(1), Me.UsedRange.Offset(1, 0)) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False 'not really necessary in this case but never a bad idea within a Worksheet_Change
Dim a As Range
For Each a In Intersect(Target, Columns(1), Me.UsedRange.Offset(1, 0))
If CBool(Len(a.Value2)) Then _
a.EntireRow.Copy _
Destination:=Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 'not really sure this is the correct destination
Next a
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
I've included a call to disable event handling for the duration of the Worksheet_Change event macro. While this is a critical step when the Worksheet_Change modifies values, it is not really important to incorporate here. However, it does not harm and is already in place in case you want to augment the Worksheet_Change to include something like a timestamp that would change the values on the worksheet.

How do i insert a new blank cell before current cell that has just been populated

I have a two (very long) TO-DO lists- one going across and the other going down.
What i want to achieve is for a blank cell to appear at the start of the list instead of having to scroll to the end of the lists to enter a new item.
So then when i have entered an item in a cell and hit enter, i want the cell just populated to move down the list (or across if i hit tab) and a new empty cell to appear at the start of the list.
It would be useful for the new blank cell to be pre-populated with the current date but that is not essential.
Thanks for your help.
NOT FOR POINTS.
Piggy-backing on Gary's answer, the mistake is that you set A to Range("C4:C6"). What happens is, when you enter data into any of C4, C5, and C6, they are all moved to the right because of A.Insert, which refers to all the cells assigned to A.
The trick here is to fully qualify your requirements for Target. Let's say you have a table from B1:E3, like below:
Now, let's say you want to move row 1 if you enter something into A1, row 2 if A2, etc. The following macro should do it (notice the difference with Gary's macro):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim QualifyingRange As Range
'Dim OrigRng As String
Set QualifyingRange = Range("A1:A3")
If Intersect(Target, QualifyingRange) Is Nothing Then Exit Sub
Application.EnableEvents = False
'OrigRng = Target.Address
Target.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'Range(OrigRng).Value = Date
Application.EnableEvents = True
End Sub
What is the difference in the above? Very simple but very important. When a Worksheet_Change is in a sheet's code, every time you do a valid change to the sheet, the macro fires. The range you just edited will be known to the macro as Target. Now, usually, if you don't declare what the qualifications for Target are, the Worksheet_Change macro just fires indiscriminately. How do we qualify Target properly then?
We use Intersect. First, we declare a range of cells that we want to track. These cells, when changed, should fire the macro. Otherwise, macro is kaput. This line: If Intersect(Target, QualifyingRange) Is Nothing Then Exit Sub basically reads: If Target is not inside my desired range, then nothing happens.
This is the reason why I declared A1:A3 as my QualifyingRange. This way, if my change is to any of the cells above, the macro will fire. HOWEVER, .Insert should not be applied to the whole range but to Target alone. This is because if we do QualifyingRange.Insert, every time a change is detected in any cells in A1:A3, all three rows will move. This is what happened when you set A to three cells and kept A.Insert.
Hopefully, this clears up the confusion. Let us know if this helps.
Here is a partial solution. The following event macro monitors entry to cell A1 . Once you have entered a value in A1, the macro "pushed" the values in column A down by one. This means that value you just entered has been pushed down to A2 and A1 is empty:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range
Set A = Range("A1")
If Intersect(A, Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
A.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Application.EnableEvents = True
End Sub
Because it is worksheet code, it is very easy to install and automatic to use:
right-click the tab name near the bottom of the Excel window
select View Code - this brings up a VBE window
paste the stuff in and close the VBE window
If you have any concerns, first try it on a trial worksheet.
If you save the workbook, the macro will be saved with it.
If you are using a version of Excel later then 2003, you must save
the file as .xlsm rather than .xlsx
To remove the macro:
bring up the VBE windows as above
clear the code out
close the VBE window
To learn more about macros in general, see:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
and
http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx
To learn more about Event Macros (worksheet code), see:
http://www.mvps.org/dmcritchie/excel/event.htm
Macros must be enabled for this to work!
EDIT#1
To push across rather than down:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range
Set A = Range("A1")
If Intersect(A, Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
A.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Application.EnableEvents = True
End Sub
To handle multiple cells, you must specify which cells get pushed across and which cells get pushed down.