VBA copy formula to other sheet, do not move "view" - excel

I'm using a VBA routine to copy
Source sheet: named range (multiple 'selections')
Target sheet: copy-paste formula from cells in named range, to cells with a certain offset from a cell on the target sheet (this offset is depending on a certain selection).
I have two types of named ranges on the source sheet; one from which I only want to copy the values (=rng_operationeel_input_data), one from which I would like to copy to formulas (=rng_operationeel_formules). The formulas should be copied 'relatively', to have references on the target sheet (which are part of the copied values from the other range). For that reason, I can't use "targetCell.Formula = sourceCell.Formula", as it then literally copies the absolute formula. Not relative.
That's why I'm using sourceCell.
I do this in a for each loop over all cells in the source range, as the named range is not one single range (set of ranges).
Note. 'datasetReferenceCell' is the cell on the target sheet from which the offset is taken for pasting.
The problem is that, even if I use VBA to do the copy-pasting, without using 'select' somewhere, still at the end the user is confronted with the target sheet. (Excel will move to the target sheet)
This is only happening, for the copy-paste part.
How can I prevent this from happening?
edit: note that I am already using "Application.ScreenUpdating" (at start to false, at the end to true). I also have a MsgBox at the end of the routine (for info that routine was successful). Excel is moving to the target worksheet after the MsgBox is closed.
Below the VBA code part.
' dataset for weeknr found: save data to dataset
Dim dataRange As Range, dataField As Range
' for each cell in input data range: save value in dataset
Set dataRange = Range("rng_operationeel_input_data")
For Each dataField In dataRange
datasetReferenceCell.Offset(dataField.Row, dataField.Column).Value = dataField.Value
Next dataField
' !!! Following are only saved, not loaded, as it are formula based fields
' for each cell in formula range: paste formula
Set dataRange = Range("rng_operationeel_formules")
For Each dataField In dataRange
dataField.Copy
datasetReferenceCell.Offset(dataField.Row, dataField.Column).PasteSpecial (xlPasteFormulas)
'datasetReferenceCell.Offset(dataField.Row, dataField.Column).Formula = dataField.Formula 'not working, as relative formulas are required
Next dataField

The only way I was able to solve it was to reset the active sheet:
Public Sub routine()
Dim activeWs As Worksheet
Set activeWs = ThisWorkbook.ActiveSheet
.. code including copy & PasteSpecial ...
activeWs.Activate
End Sub

Related

how to get data from a excel sheet to another when two criteria is true using vba

I have put 20 different project data in one excel sheet1 with s.no, name, date, description, amount, and cheque Number. now I want to filter this data in another sheet2 with name and specified date using VBA? please someone help me?
You can do this with 1 line of code & a couple of named ranges, assuming you have Office 365 version Excel.
Sub Filter()
Sheets("Sheet2").Range("B3").ActiveCell.Formula2R1C1 = "=FILTER(data,--(INDEX(data,0,2)=name_filter)*(INDEX(data,0,3)=date_filter))"
End Sub
This references 3 named ranges which you need to create before running the code:
"data" is the named range referring to these cells in Sheet 1
"name_filter" and "date_filter" are 2 cells you want to use to filter this table - these are in Sheet2 which is also where the filtered table will be
You can find out more about named ranges here: Define and Use Named Ranges. This only needs to be done once right at the beginning, the macro can then be run again and again without changing your named ranges. If rows in your data are to change (e.g. new items added/older removed etc.) then you can always create a dynamic range: Exceljet dynamic ranges.
source data:
user inputs name_filter and date_filter (J2-3 respectively) and runs macro code above to this table in Sheet 2:
Sub Button2_Click()
'
' Macro1 Macro
'
Dim rg As Range
Set rg = ThisWorkbook.Worksheets("Filterdata").Range("A1").CurrentRegion
rg.Offset(1).ClearContents
Dim rgData As Range, rgCriteria As Range, rgFilterdata As Range
Set rgData = ThisWorkbook.Worksheets("Data").Range("A4").CurrentRegion
Set rgCriteria = ThisWorkbook.Worksheets("Data").Range("A1").CurrentRegion
Set rgFilterdata = ThisWorkbook.Worksheets("Filterdata").Range("A1:G2000")
rgData.AdvancedFilter xlFilterCopy, rgCriteria, rgFilterdata, Unique:=False
End Sub
This is the code that I want to create for the advanced filter

Copy a range of cells from one worksheet to another using VBA

I'm new to using VBA and need to copy data from a range of cells on one worksheet to another worksheet. I need to copy a column of cells and paste it into a row of cells e.g. A1:A4 to A1:D1. This is the code i'm using but it doesn't work the way i need it too.
Sub Draft()
Worksheets("Material Check").Range("B3:B6").Copy _
Destination:=Worksheets("Archive").Range("A2:D2")
End Sub
Also I need the data thats being copied over to be added to the bottom of the table on the archive sheets and i'm not sure how to do this.
Without Excel Tables
This is a bit of an odd way to do it but if you have a lot of cells to do, it's possibly faster than copy/paste special:
ThisWorkbook.Worksheets("Archive").Range("A2:D2").Formula = "=INDEX('Material Check'!$B$3:$B$6,Column())"
ThisWorkbook.Worksheets("Archive").Range("A2:D2").Value = ThisWorkbook.Worksheets("Archive").Range("A2:D2").Value
The first line populates the destination range with a formula that pulls the data from the source, using INDEX/COLUMN to transpose the result.
The second line simply converts the formula to hard values.
EDIT - Solution to copy the values to the bottom of the list
Using Excel Table
To do this you will need to go to "Insert" --> "Table".
''Get a reference to your destination table
Dim Tbl1 As ListObject
Set Tbl1 = ThisWorkbook.Sheets("Archive").ListObjects("Table1") ''Change these to your destination sheet/table names
''add a new row to the table
Dim Newrow As ListRow
Set Newrow = Tbl1.ListRows.Add
''populate the new row
With Newrow
.Range(Tbl1.ListColumns("Column1").Index) = ThisWorkbook.Worksheets("Material Check").Range("B3") ''change these to your destination column name and your source sheet/ranges
.Range(Tbl1.ListColumns("Column2").Index) = ThisWorkbook.Worksheets("Material Check").Range("B4")
.Range(Tbl1.ListColumns("Column3").Index) = ThisWorkbook.Worksheets("Material Check").Range("B5")
.Range(Tbl1.ListColumns("Column4").Index) = ThisWorkbook.Worksheets("Material Check").Range("B6")
End With

Highlighting rows where a cell contains a name from a list of names

How would I go about highlighting rows which contain a cell that contains a name from a list of names which I can specify?
I assume this is best done by a macro, but not sure where to start.
Place this code in a module
Option Explicit
Public Sub ApplyConditionalFormattingsFromAList()
'
' this code create multiple conditional formattings on current selected cells
' using a list of conditions along with its formattings defined in another worksheet.
' to use, just select the range and then run this code
'
Dim iRng As Range
Dim ApplyToRng As Range
Dim wsCondition As Worksheet
' determine the worksheet that define the conditions and formattings
' to do this, create a blank worksheet and name it "Names",
' then in the worksheet,
' column A of the worksheet should contain the names to highlight, start at [A1]
' column B of the worksheet should be filled with the highlight color to apply, working in pair with column A
Set wsCondition = Worksheets("Names")
' i make the Macro to apply to current selection.
' i made it this way so that you can reuse this code on different sheets multiple times
' anyway, you can change this to apply to a fixed range, which can then be turned into automatic running code.
' e.g. Set ApplyToRng = Columns("B")
Set ApplyToRng = Selection
' clear the conditional formattings of current selection. otherwise the list of conditional formatting will keep growing.
ApplyToRng.FormatConditions.Delete
' add the conditions
For Each iRng In wsCondition.Range([A1].Address, wsCondition.Cells(Rows.Count, 1).End(xlUp))
ApplyToRng.FormatConditions.Add Type:=xlTextString, String:=iRng.Value, TextOperator:=XlContainsOperator.xlContains
ApplyToRng.FormatConditions(ApplyToRng.FormatConditions.Count).SetFirstPriority
ApplyToRng.FormatConditions(1).Interior.Color = iRng.Offset(0, 1).Interior.Color
ApplyToRng.FormatConditions(1).StopIfTrue = False
Next iRng
End Sub
The worksheet "Names" would look like this
I would write it as a macro.
Begin with the first sheet.
Find the last used column and the last used row on that sheet.
Use these figures to iterate through each cell in each row.
For each cell you iterate through you need to go to the list and iterate through each item in the list. Compare the cell value and the list value, if they are the same then highlight the row and go the next row.
I hope that helps.

Auto populate new sheet with data

I tried looking at other similiar questions and solutions but as an Excel beginner I couldn't quite figure it out.
So I have the following macro:
Sub Worksheet_Change(ByVal Target As Range)
Dim wsNew As Worksheet
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("B46:B99")) Is Nothing Then
ThisWorkbook.Sheets("LT").Copy _
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
End Sub
It opens a new sheet in the same workbook and I'd need to auto populate certain cells with data from the main sheet. Main sheet: http://i.imgur.com/RJe44hQ.jpg new sheet: http://i.imgur.com/eatbg6j.jpg . The cells I need copied are in red.
Thanks in advance for any help! Really new to all this..
Since you don't specify which value(s) you need to pull from the main sheet I can't get too specific, but in general there are three approaches to take.
1) If the data is in contiguous range(s) of cells on both sheets, you can just copy the data from the main sheet after creating the new sheet, and then paste the values to the correct target range
2) If the data isn't contiguous on both sheets, then your next best option would be to have the value for each target cell set based on the value of the corresponding cell on the main page. Ex: To set A2 on Sheet2 to the value of B4 on Sheet1 you would use Worksheets("Sheet2").Range("A2").value = Worksheets("Sheet1").Range("B4").value
3) This one also works if the data isn't contiguous, but gets to be troublesome if there are more than ~5 values to copy. You can create an appropriate variable (string for text, long/int for numbers, etc.), set that before creating the new sheet, and then use them to set the appropriate cells once the new sheet is created.

Unmerge cells and distribute contents in Excel (for mac) 2011

I have a spreadsheet with a large amount of data in. About half the cells are merged horizontally with other cells and contain names e.g. John Doe.
Does anyone know how to write a macro to unmerge the cells while distributing the value of the cell to all the cells that were previously merged?
Cheers
Jack
EDIT: The reason I am doing this is to check to see if two adjacent cells are equal i.e. is A1 = A2. But I run into problems when either cell is merged. If anyone knows a way around this problem without separating the cells and copying the data that would be even better!
The idea I provide below is tested for Excel 2010 VBA Win7. However, being not sure I hope it should work as for Mac, too (as this is rather set of standard properties and methods of Range object). If this doesn't work please let me know to delete my answer.
This simple code will work for selected area however it's quite easy to change it to any other range. Some other comment inside the code below.
Sub Unmerging_Selection()
Dim tmpAddress As String
Dim Cell As Range
'change Selection below for any other range to process
For Each Cell In Selection
'check if cell is merged
If Cell.MergeCells Then
'if so- check the range merged
tmpAddress = Cell.MergeArea.Address
'umnerge
Cell.UnMerge
'put the value of the cell to
Range(tmpAddress) = Cell
End If
Next
End sub
And the picture presenting before and after result:
I was able to get the solution from KazJaw to work on a mac with one edit, changing Cell.UnMerge to
ActiveSheet.UsedRange.MergeCells = False, as provided by Ron Debruin here: http://www.rondebruin.nl/mac/mac027.htm.
Sub Unmerging_Selection()
Dim tmpAddress As String
Dim Cell As Range
'change Selection below for any other range to process
For Each Cell In Selection
'check if cell is merged
If Cell.MergeCells Then
'if so- check the range merged
tmpAddress = Cell.MergeArea.Address
'umnerge
ActiveSheet.UsedRange.MergeCells = False
'put the value of the cell to
Range(tmpAddress) = Cell
End If
Next
End sub

Resources