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
Related
I'm new to VBA and I'm struggling a lot with a file I want to build.
I have a main Sheet that in a simple way looks like this (starting at column B - A is an empty column):
main
This is a simplified version just for the example. The first table of the sheet varies from B13 to O92, the second varies from B104 to O114 but some of those rows might be empty.
My goal is to join rows with content from the first area with rows with content from the second area in a different sheet (Sheet1), add to the left a column with 1s and "Cell 0" (content of cell B1). Using the example, the result would be something like this:
Sheet1
Sheet1 will stay hidden as I'm using it as a source of information to a different file. In fact, I may not need the 1s column if I find a way to copy information in a different way - I'm doing it like this (wsSource is Sheet1):
lRow = wsSource.Columns("A").Find(1, SearchDirection:=xlPrevious, LookIn:=xlValues, LookAt:=xlWhole).Row
wsSource.Range("B1:N" & lRow).Copy
I was trying to do it so Sheet1 is "emptied" when the file is opened and edited when file is closed - so that if new rows are added or information updated, it gets into Sheet1 every time.
I've tried several stuff I found online but couldn't make it to work. My main problem is adding the specified rows one after the others but I'm also struggling to reset Sheet1 every time the file is opened and automatically running the macro when file is closed.
Any help would be really appreciated.
Hopefully this will get you started. Both subs need to be pasted in VBE under ThisWorkBook rather module or sheet(n).
The first sub will execute when the workbook is open.
Are you sure you want to clear your sheet under these circumstances?
You will never have access to your table (without workarounds) since it will clear when opening every time.
If this is what you need, see the below method to clear a dynamic range (Col A - D down to last cell used in Col A) on Sheet1 every time the workbook that houses this code is opened.
Private Sub Workbook_Open()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim ClearRange As Range
Application.ScreenUpdating = False
With ws
.Visible = xlSheetVisible
.Range("A1:D" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents
.Visible = xlSheetHidden
End With
Application.ScreenUpdating = True
End Sub
Next, the below sub will only execute before the book is closing. This is where the bulk of your code will go to build your table.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
ThisWorkbook.Sheets(1).Visible = xlSheetVisible
'Code goes here
ThisWorkbook.Sheets(1).Visible = xlSheetHidden
Application.ScreenUpdating = True
End Sub
You will need to qualify your objects (Ranges, Cells, etc.) directly (which sheet) since the code will not be housed in a sheet. The first sub uses a With block to qualify ranges and the second sub directly qualifies all objects with ThisWorkbook.Sheets(1).
Lastly, I recommend writing your code to build your table inside a module (qualify ranges!) so you can test and debug without needing to close/open your book continuously. Once you have the code working in a module, you can copy and paste the code directly into the 2nd sub here and you are good to go!
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
I have an excel sheet with some buttons (each doing different functions) i have created an auto filter macro as shown below but the problem is when i release the filter my all buttons get very small in their sizes (means they change their original size) although i selected the radio button (Do not move or size with cell) from each button's property.
Sub AutoFilter()
Range("A1:I1628").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$I$1631").AutoFilter Field:=8, Criteria1:="="
Selection.Copy
Sheets("Blank Names").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
I am badly in need of help, please assist me with this issue.plzzzzzz
My guess is that you need to set the object positioning of the button to "Don't move or size with cells" (as seen here, unfortunately I don't have enough reputation to post images yet).
If you have many different buttons in many different spreadsheets, this code should set the property for all of them (provided none of the worksheets are protected, etc.)
Sub test()
Dim ws As Worksheet, sh As Shape
For Each ws In Worksheets
For Each sh In ws.Shapes
If sh.Type = msoFormControl Then
sh.Placement = xlFreeFloating
End If
Next
Next
End Sub
I faced the same issue and couldn't find a solution anywhere in the internet. Then on manual testing, I found that the issue is with the format.
Please clear the format from the range of cells where you're trying to put autofilter
For example, I copied data from source file and pasted the as values and then I put the autofilter.
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.
Objective: If any values in A1:A2 on sheet 1 change, then the values in A1:A2 on sheet 2 should automatically update with these values. The following sheet 1 event handler fails to work:
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Dim target As Range
Set target = Range("A1:A2")
If Not Intersect(target, Sheets(2).Range("A1:A2")) Is Nothing Then
Range("A1:A2").Value = Sheets(2).Range("A1:A2").Value
End If
Application.EnableEvents = True
End sub
As usual, VBA's mind-numbingly opaque syntax is my downfall. Any advice in implementing the above simple task would be appreciated, as would referral to a VBA reference guide that is actually useful in explaining the hidden minutia of VBA.
As others have said, you need to put the event handler in the sheet to be monitored.
Worksheet_Change will respond to changes made by the user. If a cell changes for other reasons, eg a formula calculating, then this event is not called.
Worksheet_Calculate will respond the the sheet recalculating. It has no concept of which cells on the sheet changed. To use it in your use case, either copy the cells regardless and accept it will do some unnecassary copies, or track the values of A1:A2 yourself to copy on change
Notes on your code:
Unqualified references to Range refer to the worksheet your code is in. So does Me.
You can reference a sheets CodeName to to refer to a specific sheet regardless of what the user calls it or moves it.
Trying to do an Intersect of ranges on different sheets makes no sence and will error
Sheets(1) and Sheet1 may not be the same worksheet. The Sheets collection index is in the order the sheets are displayed in Excel, and can be changed by the user.
Here's a refactor of your code (put this in Sheets 1 module to copy changes on sheet 1 to sheet 2)
Private Sub Worksheet_Calculate()
If Sheet2.Cells(1, 1).Value <> Me.Cells(1, 1).Value Or _
Sheet2.Cells(1, 2).Value <> Me.Cells(1, 2).Value Then
Application.EnableEvents = False
Sheet2.Range("A1:A2").Value = Me.Range("A1:A2").Value
Application.EnableEvents = True
End If
End Sub