I have two excel sheets sheet1 and sheet2.Sheet1 is a dynamic excel sheet,there may be chance of adding columns.I have already coded to copy column heading from sheet1 to sheet2 dynamically.
Sheet1:
Prdct Id PrdctQty Unitprice PrdctQty
1 5 10 50
2 10 10 100
sheet2:
Prdct Id PrdctNme Unitprice PrdctQty
When i open sheet2,these headings automatically appears from sheet1(using macro).There are 2 buttons in sheet2.
1.Display-display product details on matching Prdct Id entered by the user(that also done through macro)
2.Add- To add new product,user can enter Prdct Id , PrdctNme, Unitprice and it will be copied to sheet1 (through macro)
Sheet1 also contains other columns having fromulas(which i didnt show in the example)and sheet1 can grow dynamically.
So what i want is when user enters Prdct Id , PrdctNme, Unitprice then PrdctQty should automatically come in sheet2 (along with other calculated columns which i am not including for the time being) and after that i can add the new product to sheet1
i tried this code (from stackoverflow)
Sub dural()
Dim r As Range, ady As String
For Each r In Sheets("Sheet1").Cells.SpecialCells(xlCellTypeFormulas)
ady = r.Address
r.Copy Sheets("Sheet2").Range(ady)
Next
End Sub
but what i am getting is a whole copy of sheet1 in sheet2 along with values.What i need is only formulas not values
Try Something like this :
Sub moveformulas ()
Sheets(1).UsedRange.SpecialCells(xlCellTypeFormulas).Copy
Sheets(2).Range("A1").PasteSpecial
End Sub
I found a way even though i am not sure its the right way.
Sub dural()
Dim r As Range, ady,ady2 As String
For Each r In Sheets("Sheet1").Cells.SpecialCells(xlCellTypeFormulas)
ady = r.Address
ady2=r.formula
Sheets("Sheet2").Range(ady).formula=ady2
Next
it worked for me
Sub CopyOnlyFormulas()
Sheets(1).UsedRange.Copy
Sheets(2).Cells.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone
For Each cell In Sheets(2).UsedRange
If Not cell.HasFormula Then
cell.Clear
End If
Next
End Sub
Sub CopyDataAndFormulas()
Sheets(1).UsedRange.Copy
Sheets(2).Cells.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone
End Sub
Related
Use case: I want to copy data from column A to Column B (where column A, B are arbitrary columns). Once the data is in Column B, I want to remove duplicate entries within column B.
Make a loop that moves data from column A to column B and then removes duplicates for each sheet in a workbook.
`Sub Copy()
For i = 1 To Sheets.Count
Worksheets(i).Range("A1:A100")
Destination:=Worksheets(i).Range("B1")
Next
End Sub
`
For testing I separated the tasks into two different Sub(). Sub Copy() is working and correctly copies my data. Sheet1 is also named "Sheet1" for my specific workbook
`Sub RemoveStuff()
Dim rng As Range
For j = 1 To Sheets.Count
Set rng = Worksheets("Sheet1").Range(Range("B1"),Range("B1").End(xlDown)).Select
rng.RemoveDuplicates Columns:=(1), Header:=xlGuess
Next
End Sub
`
My error seems to be in defining the range correctly. Each sheet will have a different number of entries to remove duplicates from. Sheet1 might have 50 rows and reduce to 6. Sheet2 could have 70 and reduce to 3. Sheet3 could have 20 rows and reduce to 12 uniques. Excel does not let you remove duplicates from range (B:B!)
How can I properly define my range so I can remove duplicates in a loop for a dynamically defined range for each sheet(sheet=tabs in workbook)?
EDIT 2-23-17
New code from Y0wE3K
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Columns("P:P").RemoveDuplicates,Columns:=1, Header:=xlYes
Next
End Sub
Still does not work. If I manually select Column P before I run the macro, it works. But it only goes for the one sheet I have selected, it does not seem to execute the loop. Definitely does not automatically do each sheet, or prompt me for each one.
EDIT: 3/4
Make sure that you do not have any protected data, I also experienced issues with pivot tables but I think this may be permissions thank you for help.
Your RemoveStuff subroutine can be rewritten as:
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets ' Use Worksheets instead of Sheets,
' in case there are any Charts
'You can just select the whole column, rather than selecting
'specific rows
ws.Columns("B:B").RemoveDuplicates Columns:=1, Header:=xlGuess
Next
End Sub
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Columns("P:P").RemoveDuplicates,Columns:=1, Header:=xlYes
Next
End Sub
This code will work. As a final note, please make sure you have no Protected Data, or pivot tables inside of the sheets you need to run the remove script on. For whatever reason that caused mine to fail, but running my script on the correct sheets that are unprotected worked GREAT.
I need to copy the cell contents in C10 from one sheet (called "New Customers") to another sheet's (called "Inventory") next available row.
Once the cell is copied, it should be copied or autofilled down 10 times. So 10 rows in the Inventory sheet have the same Customer ID populated.
Note: This macro will be ran multiple times and it should always populate the "Inventory" sheet with whatever the next avaiblaable 10 rows are at that point.
I have not figured out the Autofill part. That's where I need your help, the rest does what it should. Any ideas on how to fix this?
Sub copyCustomer()
'copy customer ID into inventory sheet. Then autofill inventory 10 times.
'need for this to OFFSET to add a new customer next time macro is ran.
Set Source = Sheets("New Customers")
Sheets("New Customers").Select
Range("C10").Select
Selection.Copy
Sheets("Inventory").Select
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
'Autofill this 10 times
End Sub
Try this (which replaces all your present code)
Sub copyCustomer()
Sheets("New Customers").Range("C10").Copy Sheets("Inventory").Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(10)
End Sub
I am busy creating a production schedule in excel 2010. I have used formulas to give me due dates for each job and a check box for when the job are done. I used the following VB to move the information to sheet 2 when the check box is checked.
Sub MoveData()
If ThisWorkbook.Worksheets(1).Shapes("Check Box 1").OLEFormat.Object.Value = 1 Then
Range("A2:B2:C2:D2:E2:F2:G2:H2:I2:J2:K2:L2:M2").Select
Selection.Cut
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
End If
End Sub
The problem I have now is that it moves the formulas with the details in the cells from sheet 1 to sheet 2. I need the formulas to be locked in sheet 1 and affect new information inserted into the cells.
When the data in the row moves to sheet 2 the row is empty in sheet 1. Is there a way to automatically move all the remaining data up to fill the empty cells
Thanx
Do you just want to copy the values from Worksheets(1) to Sheets("Sheet2")?
Sub MoveData()
Dim r As Range
If ThisWorkbook.Worksheets(1).Shapes("Check Box 1").OLEFormat.Object.Value = 1 Then
Set r = Worksheets(1).Range("A2:B2:C2:D2:E2:F2:G2:H2:I2:J2:K2:L2:M2")
Sheets("Sheet2").Range("A1").Resize(1, r.Count) = r.Value
'r.ClearContents
End If
End Sub
Instead of cut and paste try the following.
Sub MoveData()
If ThisWorkbook.Worksheets(1).Shapes("Check Box 1").OLEFormat.Object.Value = 1 Then
Sheets("Sheet2").Range("A1:M1").Formula = Sheets("Sheet1").Range("A2:M2").Formula
Range("A1").Select
End If
End Sub
Edit:
If you were cutting to remove the originals from Sheet1 just use,
Sheets("Sheet1").Range("A2:M2").Clear
I'm really hoping someone can help me with this one. I have recorded a macro to use within a sheet that needs to create a row at the same position on 2 worksheets and then, on one of them, copy the formula's in the cells from the row below it. The code I have looks like this -
Sub Macro1()
Sheets(Array("SCHEDULE", "ANNUAL SUMMARY")).Select
Sheets("SCHEDULE").Activate
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("ANNUAL SUMMARY").Select
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.AutoFill Destination:=ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow _
, Type:=xlFillDefault
ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow.Select
Sheets("SCHEDULE").Select
ActiveCell.Select
My problem is, when I run it manually and then record the macro, it does exactly what I want it to, but when I run this from a button on the "SCHEDULE" sheet it does not copy the formula's from the row below the one on the "ANNUAL SUMMARY" sheet.
Can anyone help to get this working with me?
Thanks all in advance
Mark
The problem with the macro recorder is that although it can give you a good indication of what code you need, it also generates very inefficient code and includes all of the select and activate statements that you need to try and avoid using.
Any reference in the code to ActiveCell is referring to the cell that is currently selected and ActiveSheet is the sheet that is currently selected. This can give you undesired results if you run the macro from a different sheet that the macro was recorded from...
If you wanted to copy row 1 from SCHEDULE sheet then you can use
Sheets("SCHEDULE").Rows(1).Copy Sheets("ANNUAL SUMMARY").Rows(1)
If you want to auto fill a range, then this can be accomplished with a single line of code
This will auto fill the contents of row1 (column A - E) down to row 100 in your ANNUAL SUMMARY sheet
Sheets("ANNUAL SUMMARY").Range("A1:E100").FillDown
So if we put it all together and include some declarations for our source and destination sheet to make the sub more readable..
Sub CopyAndFillDownExample()
Dim rowNumber As Long, offset As Long
Dim sourceSht As Worksheet, destinationSht As Worksheet
'set the source and destinationsheets
Set sourceSht = Sheets("SCHEDULE")
Set destinationSht = Sheets("ANNUAL SUMMARY")
'number of rows to copy down
offset = 100
'get currently selected row
rowNumber = ActiveCell.Row
'copy the selected row from the source sheet to the destination sheet
sourceSht.Rows(rowNumber).Copy destinationSht.Rows(rowNumber)
'fill down the formulas
destinationSht.Rows(rowNumber & ":" & rowNumber + offset).FillDown
End Sub
I am trying to create an excel macro which is probably going to end up being quite large, to make things easier I am tackling it a bit at a time. So far I have....
Sub Macro4()
'
' Test Macro
'
'Selects the product_name column by header name
Dim rngAddress As Range
Set rngAddress = Range("A1:Z1").Find("product_name")
If rngAddress Is Nothing Then
MsgBox "The product_name column was not found."
Exit Sub
End If
Range(rngAddress, rngAddress.End(xlDown)).Select
'Inserts new column to the left of the product_name column
Selection.Insert Shift:=xlToRight
'Re-selects the product_name column
Range(rngAddress, rngAddress.End(xlDown)).Select
'Copys the contents of the product_name column
Selection.Copy
Selection.Paste
End Sub
I want it to do the following....
Search the spreadsheet for the header name 'product_name'
Insert a blank column to the left of the 'product_name' column
Copy the contents of the 'product_name' column
Paste them into the newly created blank column
Change the header name in this new column to 'product_name_2'
Currently it works fine up until the pasting into this newly created column, then i get a
'Run-time error '438'; - Object doesn't support this property or method'
Can anyone suggest where i am going wrong?
Your error is:
Range(rngAddress, rngAddress.End(xlDown)).Select
This selects from the top of the column down to just above the first blank cell. The insert shifts this portion of the column right leaving the rest where it is. When you select again you are likely to get a larger range because you have mixed two columns. The copy fails because you are then trying to copy values over the top of values.
If that does not make sense, step through your macro with F8 and see what is happening at each step.
When you understand why your current macro does not work, try this:
Sub Macro5()
Dim rngAddress As Range
Dim ColToBeCopied As Integer
Set rngAddress = Range("A1:Z1").Find("'product_name")
If rngAddress Is Nothing Then
MsgBox "The product_name column was not found."
Exit Sub
End If
ColToBeCopied = rngAddress.Column
Columns(ColToBeCopied).EntireColumn.Insert
Columns(ColToBeCopied + 1).Copy Destination:=Columns(ColToBeCopied)
End Sub
Note:
I did not select anything.
I have left the code operating on the active sheet but it is better to use With Sheets("XXX") ... End With.
Answer to second question
The macro recorder is not good at showing how to address individual cells systematically.
With Sheets("xxxx")
.Cells(RowNum,ColNum).Value = "product_name 1"
End With
The above uses With which I recommend. Notice the dot in front of Cells.
The one below operates on the active sheet.
Cells(RowNum,ColNum).Value = "product_name 1"
RowNum must be a number. ColNum can be a number (say 5) or a letter (say "E").
In your case RowNum is 1 and ColNum is ColToBeCopied and ColToBeCopied + 1.
P.S.
I forgot to mention that to find the botton row of a column use:
RowLast = Range(Rows.Count, ColNum).End(xlUp).Row
That is move up from the bottom not down from the top.
P.S. 2
To specify a range using Cells:
.Range(.Cells(Top,Left),.Cells(Bottom,Right))
The dots must match: all three or none.
I'm not sure where you are trying to copy to,
but when you want to paste you need to make a selection and then
ActiveSheet.Paste
For example:
/your code/
Selection.Copy
Range("O:O").Select
ActiveSheet.Paste
I would avoid copying / pasting altogether, if you only want to transfer values.
For example, instead of:
Range("B1:B100").Copy Destination:=Range("A1")
I would use:
Range("A1:A100").Value = Range("B1:B100").Value
If we were to substitute that into your code, and include some of the comments made by Tony:
Sub Macro4()
Dim colFound As Integer
Dim rowLast As Long
Const rowSearch As Integer = 1
'Find the product_name column
colFound = Rows(rowSearch).Find("product_name").Column
If colFound = 0 Then
MsgBox "The product_name column was not found."
Exit Sub
End If
'Find the last non-empty row
rowLast = Cells(Rows.Count, colFound).End(xlUp).Row
'Inserts new column to the left of the product_name column
Columns(colFound).EntireColumn.Insert
'Transfer the contents of the product_name column to the newly inserted one
Range(Cells(rowSearch, colFound), Cells(rowLast, colFound)).Value = _
Range(Cells(rowSearch, colFound + 1), Cells(rowLast, colFound + 1)).Value
'Rename the new column
Cells(rowSearch, colFound).Value = Cells(rowSearch, colFound).Value & "_2"
End Sub