Excel Macro to Copy Formulas & Copy/Paste Values - vba

I am trying to create an Excel Macro to copy formulas along a used range and then copy the form and paste values.
I was thinking that I house the formulas that need to be copied in a template file in row 1. Users can then input data into as many rows as they please, and the macro will copy down all formulas to all used rows, and then copy/paste values of the entire sheet.
Can anyone help with writing this? I have attempted to write it myself but haven't been able to get very far.
Thanks!
EDIT- - I have gotten the copy part down I believe. Now I just need to copy/paste values on the majority of the sheet, starting from row 4 down.
Sub Forecast()
Application.ScreenUpdating = False
' Get the last row on the sheet - store as variable
Dim LastRow As Integer
LastRow = Range("A1").End(xlDown).Row
' Copy cells K3:AY3 to cells K4:AY[LastRow]
Range(Cells(3, 11), Cells(3, 51)).AutoFill _
Destination:=Range(Cells(3, 11), Cells(LastRow, 51))
Application.ScreenUpdating = True
End Sub


To copy the values for a variable number of rows between two locations do the following:
Dim r_src as Range, r_dst as Range
' Set to the top cell of the source
Set r_src = Sheet1.Range("A2")
Dim n as Long
' Count the non-empty cells
n = Sheet1.Range(r_src, r_src.End(xlDown)).Rows.Count
' Set the range to include all 'n' cells using the `.Resize()` command
Set r_src = r_src.Resize(n,1)
' Set 'n' values in the destination sheet also
Set r_dst = Sheet2.Range("A2").Resize(n,1)
'This actually copies the range as values in one swoop
r_dst.Value = r_src.Value
To copy the formulas you can use
r_dst.FormulaR1C1 = r_src.FormulaR1C1

Related

VBA Excel Copy and Insert Varying Number of Rows with Values and Formatting

I am attempting to write a macro that would work for various worksheets. These are updated on a monthly basis. In these worksheets we have between 30 and 100 rows at the top of the sheet with formulas regarding the current month. Below we have all of the previous months numbers but without formulas.
Each month we copy the top set of rows and insert them as values w/ same formatting below the rows with formulas so that we may start the month again, but have a record of last months numbers.
In summary, I need all of the columns, and (X number of rows) copied and inserted starting in row (X+1) as only the values and formatting. Also row (X+1) is not the end of the sheet.
I have some start on the code below, but the first column does contain blank values.
Sub MonthlyReset()
Dim TotalImpacts As Worksheet
Dim LastImpacts As Range
Dim Counter As String
Set TotalImpacts = Worksheets("Total Impacts")
Counter = Application.WorksheetFunction.Match("STOP", ThisWorkbook.Sheets(TotalImpacts).Column(1), 0)
LastImpacts = ThisWorkbook.Sheets(TotalImpacts).Rows("1:" & Counter)
Rows(Counter).Resize(Counter).Insert
'Copying Impacts
ThisWorkbook.Sheets(TotalImpacts).LastImpacts.Copy
'Paste Values then Formatting
ThisWorkbook.Sheets(TotalImpacts).Range("A" & Counter + 1).PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Sheets(TotalImpacts).Range("A" & Counter + 1).PasteSpecial Paste:=xlPasteFormats
'Clear Clipboard
Application.CutCopyMode = False
End Sub

This isn't the most efficient way, but inserting entire rows can be a pain in excel, interestingly enough. But trying to be true to your original ideas, this should work.
Sub MonthlyReset()
Dim TotalImpacts As Worksheet
Dim LastImpacts As Range
Dim Counter As String
'Set the worksheet we are working with
Set TotalImpacts = Worksheets("Total Impacts")
'Find the row that STOP is on
Counter = Application.WorksheetFunction.Match("STOP", TotalImpacts.Columns(1), 0)
'Set the range for the data we want to copy
Set LastImpacts = TotalImpacts.Rows("1:" & Counter)
'Copy and insert
LastImpacts.Copy
LastImpacts.Offset(Counter).Insert shift:=xlShiftDown
'Paste Values then Formatting
TotalImpacts.Range("A" & Counter + 1).PasteSpecial Paste:=xlPasteValues
TotalImpacts.Range("A" & Counter + 1).PasteSpecial Paste:=xlPasteFormats
'Clear Clipboard
Application.CutCopyMode = False
End Sub
In the end, the range is pasted twice, the first time with the formulas to be able to insert the correct amount of rows. The second time is to paste values and then formulas alone, as you had done in your original code.

Is there a way to get the paste section of this code to cycle down one row at a time each time data is pasted?

My aim with this bit of code is to paste the contents of column D into a different Sheet if the contents in column N on the same row within the initial Sheet is = "REDUCE ONLY".
I'm struggling to find a way to paste all the entries into the second Sheet with no blank rows between them.
Currently I'm sorting the initial Sheet so all the REDUCE ONLY entries are in order at the top of the column N so they're ordered correctly in the output sheet but this isn't very robust if I get a different set of values to what's expected in column N. Is there a different way to phrase:
"cfdSht.Cells(c.Row - 1, 1).PasteSpecial Paste:=xlPasteValues"
So far I've got:
Dim c As Range
Dim rCheck As Range
Dim LRMAIN As Long
Dim cfdSht As Worksheet
Dim mainSht As Worksheet
Set mainSht = ThisWorkbook.Worksheets("Sheet1")
Set cfdSht = ThisWorkbook.Worksheets("ProductSettingNgCfd")
''Set Last Row
LRMAIN = mainSht.Range("A2").CurrentRegion.Rows.Count
''Set Range
Set rCheck = mainSht.Range("B2:N" & LRMAIN)
''Copy any value in column D where the value on the same row in column N is "REDUCE ONLY". Paste into second Sheet with starting point adjusted up 1 row.
For Each c In rCheck
If c.Value = "REDUCE ONLY" Then
mainSht.Cells(c.Row, 4).Copy
cfdSht.Cells(c.Row - 1, 1).PasteSpecial Paste:=xlPasteValues
End If
Next
Thanks

Replace this:
mainSht.Cells(c.Row, 4).Copy
cfdSht.Cells(c.Row - 1, 1)
With this
cfdSht.Cells(cfdSht.RowsCount, 1).End(xlUp).Offset(1).value = mainSht.Cells(c.Row, 4).Value
The first part will start at the bottom of the sheet then go up to the first occupied cell then move one down to the first unoccupied cell.
I used the direct assign method, because it is less taxing on the process than copy and paste. As you were looking only for values this will just put the value of the one cell into the other.

Copy and paste information from one worksheet to another within a workbook based on matching ID

I would need a code that would allow me to copy and paste the information based on the matching IDs. The problem is that the number of rows that both my sheets has is more than 200000 rows with IDs on each rows. Some of the IDs are repeated in sheet 2. I only manage to create a code but it seems to be running and then it crash. Sheet 2 consist of all the information while Sheet 1 is where the information will be pasted when the IDs from both sheets matched.
This is the code that i have so far. I really hope anyone could help me with this as this code seems to keep running and crash and my VBA skills is very limited,
Sub AAA()
Dim tracker As Worksheet
Dim master As Worksheet
Dim cell As Range
Dim cellFound As Range
Dim OutPut As Integer
Set tracker = Workbooks("test.xlsm").Sheets("Sheet1")
Set master = Workbooks("test.xlsm").Sheets("Sheet2")
For Each cell In master.Range("A2:A100000")
' Try to find this value in the source sheet
Set cellFound = tracker.Range("A5:A100000").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not cellFound Is Nothing Then
' A matching value was found
' So copy the cell 2 columns across to the cell adjacent to matching value
' Do a "normal" copy & paste
cellFound.Offset(ColumnOffset:=2).Value2 = cell.Offset(ColumnOffset:=2).Value2
' Or do a copy & paste special values
'cell.Offset(ColumnOffset:=2).Copy
'cellFound.Offset(ColumnOffset:=1).PasteSpecial xlPasteValues
Else
' The value in this cell does not exist in the source
' Should anything be done?
End If
Next
OutPut = MsgBox("Update over!", vbOKOnly, "Update Status")
End Sub

I had the same problem and was able to resolve it by deallocating the variable cellFound before re-assigning it. So, I suggest that you add:
Set cellFound = Nothing
right after the End If.
Hope that helps.

Multiple cells selecting and copying to a single row on another worksheet

I've been looking around for this for the past couple days and can't seem to find anything to help me accomplish what I'm trying to do.
I have a sheet that contains data in multiple cells that a user inputs - I would like for when the user hits the submit button that a VBA Macro would copy the data from the multiple cells and paste it into another worksheet on a single row (last row) so I can pull that data later and make changes to it if needed. The worksheet has a unique ID on the top and when searched with that I could pull the data back to the worksheet and make edits to it and save it again.
When I record a Macro and try to multiple select it doesn't let me copy but this is the code that is supplies for the select
Sub Copy()
'
' Copy Macro
'
Union(Range( _
"J22:K22,M22,I24:J24,K24:L24,M24,I26:J26,K26:L26,M26,B29:D29,E29:G29,B30:D30,B31:D31,B33:D33,E33:G33,I29,J29:K29,M29,I31:J31,K31:L31,M31,I33:J33,K33:L33,M33,B36:D36,B37:D37,B38:D38,E36:G36,B40:D40,E40:G40,I36,J36:K36,M36" _
), Range( _
"I38:J38,K38:L38,M38,I40:J40,K40:L40,M40,B2:F3,B2:F3,B6:E6,F7:G7,B7:E7,B8:E8,B9:E9,B11:C11,D11:E11,B13:C13,D13:E13,I3:L3,L2,M1,I6:L6,I7:L7,I8:L8,I9:L9,M7,I11:J11,K11:L11,I13:J13,K13:L13,B15:M16,B18:M19,B22:D22" _
), Range("B23:D23,B24:D24,E22:G22,B26:D26,E26:G26,I22")).Select
End Sub
This is all the cells I need to copy over and paste to a "Entries" Worksheet in the same workbook. I'm sure someone has asked this before but I'm not sure I'm not using the right key words to search but I'm not finding anything. Allot of stuff to copying multiple row and columns and pasting but nothing for multiple cells.

I think this is what you're trying to do
Sub test()
Dim rng As Range
Set rng = Union(Range( _
"J22:K22,M22,I24:J24,K24:L24,M24,I26:J26,K26:L26,M26,B29:D29,E29:G29,B30:D30,B31:D31,B33:D33,E33:G33,I29,J29:K29,M29,I31:J31,K31:L31,M31,I33:J33,K33:L33,M33,B36:D36,B37:D37,B38:D38,E36:G36,B40:D40,E40:G40,I36,J36:K36,M36" _
), Range( _
"I38:J38,K38:L38,M38,I40:J40,K40:L40,M40,B2:F3,B2:F3,B6:E6,F7:G7,B7:E7,B8:E8,B9:E9,B11:C11,D11:E11,B13:C13,D13:E13,I3:L3,L2,M1,I6:L6,I7:L7,I8:L8,I9:L9,M7,I11:J11,K11:L11,I13:J13,K13:L13,B15:M16,B18:M19,B22:D22" _
), Range("B23:D23,B24:D24,E22:G22,B26:D26,E26:G26,I22"))
Dim WSEntries As Worksheet
Set WSEntries = Sheets("Entries")
Dim lastrow As Integer
lastrow = WSEntries.Cells(Rows.Count, "A").End(xlUp).Row
Dim i As Integer
i = 1
For Each c In rng
WSEntries.Cells(lastrow + 1, i) = c
i = i + 1
Next
End Sub
It will iterate through your range left to right from top to bottom.
Are you sure you want to use unionkb though? You could just set your range as all the cells I think it used a union due to the character limit of a function. Did you mean to use intersect kb?
To be clear you're working with three ranges here -
Range("J22:K22,M22,I24:J24,K24:L24,M24,I26:J26,K26:L26,M26,B29:D29,E29:G29,B30:D30,B31:D31,B33:D33,E33:G33,I29,J29:K29,M29,I31:J31,K31:L31,M31,I33:J33,K33:L33,M33,B36:D36,B37:D37,B38:D38,E36:G36,B40:D40,E40:G40,I36,J36:K36,M36")
Range("I38:J38,K38:L38,M38,I40:J40,K40:L40,M40,B2:F3,B2:F3,B6:E6,F7:G7,B7:E7,B8:E8,B9:E9,B11:C11,D11:E11,B13:C13,D13:E13,I3:L3,L2,M1,I6:L6,I7:L7,I8:L8,I9:L9,M7,I11:J11,K11:L11,I13:J13,K13:L13,B15:M16,B18:M19,B22:D22")
Range("B23:D23,B24:D24,E22:G22,B26:D26,E26:G26,I22")
No cells intersect all three ranges.
B2:F3 is twice listed in the second range. Otherwise I don't see any overlap.

how to create macro because values to be copy in DropDown are increasing always. and I have to give Source to Create List in Data Validation

I want to make drop Down List in sheet2 which contains values from sheet1 column. I have tried this code.
Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
endRow = 10 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1
For r = 1 To endRow 'Loop through sheet1 and search for your criteria
If Cells(r, Columns("B").Column).Value = "YourCriteria" Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("Sheet2").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
'Switch back to your table & continue to search for your criteria
Sheets("Sheet1").Select
End If
Next r
columns in sheet1 are changing oftenly. so needs to create Dynamic VBA Macro code.
Please guide me for this query.

For your case, I don't think that you need a macro to manage the drop down list but perhaps data validation will do.
Create a new worksheet,
I got a worksheet contain the following data at column A
At the worksheet that i want the dropdownlist, i just highlight the cell and click on the data validation button at data ribbon
In the data validation, create the following setting
Click on the ok button and the list will be created
Since in the columns in the worksheet(source) keep on changing, you need write the macro to copy the entire needed column exclude the header of the column to next worksheet(e.g. worksheet that create the dropdown list).
Edited: Code to detect the criteria column and copy the column
Option Explicit
Dim MyWorkbook As Workbook
Dim MyWorksheet As Worksheet
Dim MyWorksheet2 As Worksheet
Dim WantedColumn As Long
Dim ColumnPointer As Long
Sub copyCriteria()
Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set MyWorksheet = MyWorkbook.Sheets("Sheet6")
Set MyWorksheet2 = MyWorkbook.Sheets("Sheet5")
For ColumnPointer = 1 To MyWorksheet.Cells(1, Columns.Count).End(xlToLeft).Column
If MyWorksheet.Cells(1, ColumnPointer).Value = "ColumnE" Then
MyWorksheet.Columns(ColumnPointer).Copy
MyWorksheet2.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
MyWorksheet2.Rows("1:1").Delete Shift:=xlUp
End If
Next
End Sub

What you are trying to do can be done with a simple named range and Data Validation to use that Name. If you have not heard of Dynamic Ranges, then you should read on.
If Sheet1 only has the 1 column for the DropDown list via Data Validation, you should use a Named Range instead of a fixed Range. But this named range is dynamic (by using formula)! See OFFSET usage.
Lets say Sheet1 is like below:
Lets say the name to be used is MyList, then in Excel click Name Manager in Formulas tab, and place in below as the Range Refers to:
=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A))
Now in Sheet2, the Data Validation is placed on B2, when setting it up, once you put in the source to =MyList, Excel highlights it:
Then the drop down list worked:
Now if you add data to your list (Column A on Sheet 1), the MyList automatically expands and hence your DataValidation drop down list!
Note the list will go up to the first blank cell in Column A, so NO GAPS!
Enjoy!