Excel Macro - Take a snapshot of Particular Range - vba

I have come around a very strange requirement in my Excel Dashboard.
I have a some data in a Range in a particular sheet. I need to take a
snapshot of it and display it as an Image in all other sheets at top.
I know I can simply copy & paste the range but that kind of Header is creating some issues while hiding columns on the sheets.
Any solution/trick for that same?

Range has a .CopyPicture method.
Or use the Camera tool:
Sub Tester()
Sheet1.Range("D5:E16").Copy
Sheet2.Activate
Sheet2.Range("A1").Select
ActiveSheet.Pictures.Paste Link:=True
Application.CutCopyMode = False
End Sub

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

Merging from multiple worksheets into one worksheet but its format is not like the original one

I'm new into coding, so please help me.
This code is from kutools.I want to merge all the worksheets into one sheet, but the "combined" sheet should be the last of the worksheets. So I have edited some parts of the code.
when I run, it turns abnormal, it's very different if you put the combined sheets in sheets(1).
it seems the format in original sheets like font, length of column, has varied a lot. The result is like I have done "PASTE VALUE" only. It's very different if I change the destination in sheets(1).
Sorry for bad English, here's one example of my sheet, all sheets have the same format and header.
Here's the result when I combined all data in new sheets, on the last sheet named "RAW" the format has gone.
The format is very important for presenting reports in a proper presentable way to Seniors.
would you please help me for better format?
And here's the code.
Sub merge()
Dim P As Integer
Dim lastws As Worksheet
On Error Resume Next
'Sheets(1).Select
'Worksheets.Add
'Sheets(1).Name = "RAW"
'Set lastsht = After:=Worksheets(Worksheets.Count)
'Worksheets(Worksheets.Count).Select
'Worksheets.Add
'Worksheets(Worksheets.Count).Name = "RAW"
Set lastws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
lastws.Name = "RAW"
'nice udah bisa
Sheets(1).Active
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets("RAW").Range("A1")
For P = 2 To Sheets.Count
Sheets(P).Activate
Range("A5").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets("RAW").Range("A65536").End(xlUp)(2)
Next
Sheets("RAW").Select
MsgBox ("Here is merged data!")
End Sub
Get rid of On Error Resume Next and you'll be able to see errors in your own code, the reason you don't get a heading is because sheets(1).active is not valid code you're just copying the 1st row from raw back over itself at the moment. columns("a:k").autofit will resize the columns in your destination sheet. As for the rest of the formatting, you haven't actually shown it in your first sheet, but a straight .copy destination:=whatever as you have used should preserve cell formatting fine

Copy/Paste variable dataset between workbooks without clipboard

I've been trying to optimize some of my coding and managed to cut and speed it up a lot. However there are some things that are still quite clunky (and me still a noob). Backstory is that my code is opening source and target files, copies a lot of data of variable length, closes source and then does a lot of operations and finally saves target file.
One of the things Id like is to do if possible is a direct copy of data without using clipboard, activating workbooks, selecting sheets (whatever of this is possible to pack into more efficient code that I am currently having)
Windows("SOURCE.xlsm").Activate
Sheets("Data").Select
Range("A2:AX10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("TARGET.xlsm").Activate
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Is it possible to do a selection (A2:AX10 and all the way down to last row) in SOURCE file-Data sheet and directly copy it to TARGET file-Data sheet cell A2 without using clipboard.
The reason why I use A2:AX10 and then selection down is because I have a lot of blank cells in the whole data set and this way I get entire data.
I would like to be able to to that selection and use it as a range in this line
Workbooks(“SOURCE”).Worksheets("Data").Range(“A2:AX10 & ALLTHEWAYDOWN”).Copy _Workbooks(“TARGET”).Worksheets("Data").Range(“A2")
I was trying to solve this but I dont end up with desired result. When I try doing selection and setting as range then both trying copy range with activitng workbooks and in the direct copy mode I get 1004 error.
Is it possible to optimize this chunk and make it work. It would improve a lot of my VBA.
Thanks,
You need something like this:
With Workbooks("SOURCE.xlsm").Sheets("Data")
.Range("A2:AX10", .Range("A2:AX10").End(xlDown)).Copy Workbooks("TARGET.xlsm").ActiveSheet.Range("A2")
End With
You could probably also use CurrentRegion rather than End(xlDown
You can set one range's values (the range where you would want to paste values) equal to a source range's values (the range which you would previously have copied).
Sub paste_values()
Dim wb_A As Workbook, ws_A As Worksheet
Dim wb_B As Workbook, ws_B As Worksheet
Dim last_row As Long
Set wb_A = ThisWorkbook
Set ws_A = wb_A.Sheets(1)
Set wb_B = Workbooks("WorkbookB")
Set ws_B = wb_B.Sheets(1)
With ws_A
last_row = .Range("A" & .Rows.Count).End(xlUp).Row
End With
ws_B.Range("A2:AX" & last_row).Value = ws_A.Range("A2:AX" & last_row).Value
End Sub
This code is setting the new range's values equal to the original range. It prevents the need to activate sheets or workbooks, whilst also copying data to a range without filling the clipboard.
I would also recommend using last_row = .Range("A" & .Rows.Count).End(xlUp).Row to find the last row of your data. Although you do need to ensure you use this on a column which you know contains continuous data.

Run time Error - 438

I have the following code in which I am trying to copy data from one sheet to another in same workbook. When I run the code I get Runtime error -438
Sub Copy()
Sheets("Sheet1").Range("A1:D20").Copy
Sheets("Sheet2").Activate
Range("E1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
Try the following code. You should not rely on Activate and Select.
Sub ZCopy()
Sheets("Sheet1").Range("A1:D20").Copy
Sheets("Sheet1").Paste Destination:=Worksheets("Sheet2").Range("E1")
Application.CutCopyMode = False
End Sub
Interesting Reads
MSDN
How to avoid using Select in Excel VBA macros
Do you have a particular need for copy and paste? This can be slow and inefficient. If you're just copying data from one sheet to another, you can set the values of one range equal to the values of another range and avoid the whole thing.
Sheets("Sheet2").Range("E1:H20").Value = Sheets("Sheet1").Range("A1:D20").Value
This will set the range from cells E1:H20 on Sheet2 to the same values as those in the range A1:D20 on Sheet1, which is effectively a copy and paste. I should add that this will work only for the values themselves.
If there is specific formatting (or formulas) that you need copied and pasted, this method won't work.

how to prevent re sizing of buttons after release of auto filter in excel 2010 using vba

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.