I am running into issues with the Paste Special part of the following code
Sub Copy_Filter1()
Sheets("MASTER PLACEMENT").Select
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Sheets("MASTER PLACEMENT").Range("A1").CurrentRegion.AutoFilter
Selection.AutoFilter Field:=52, Criteria1:=">=104"
Columns("AG:AS").EntireColumn.Hidden = True
Rows("1:1").EntireRow.Hidden = True
If (Range("A" & Rows.Count).End(xlUp).Row <= LastRow) Then
Range("A2").CurrentRegion.Copy
Sheets("Sheet1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
End If
End Sub
PasteSpecial is a method of the Range object, not the Worksheet object (which is where you are currently using it).
For example, your call should look like:
' Paste the current clipboard contents to cell B2 on Sheet1.
Sheets("Sheet1").Range("B2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
use something like below
Sub Copy_Filter1()
Sheets("Sheet1").Range("A1:A1000").Select
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet1").Range("A1").CurrentRegion.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=">=104"
If (Range("A" & Rows.Count).End(xlUp).Row <= LastRow) Then
Range("A2").CurrentRegion.Copy
Sheets("Sheet1").Range("C3").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If
End Sub
Related
I have written the below code. I have 3 worksheets: Dashboard, Workings and Data. I have a data validation list on worksheet(Dashboard) which has a long list of companies.
I want to be able to select a company from the list, press a button and then match from a company list in the worksheet data which has plenty of other columns for corresponding data for that company. I want to be able to take certain data from the company chosen and paste it into the next available row in worksheet (Workings). The list in the worksheet (data) has multiple entries for the same company, hence why I have added a loop in here.
This code does no give an error but does not give any result.
Can someone please tell me where I'm going wrong
Many thanks.
Sub pull_data()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
CompanyListLocation = Worksheets("Dashboard").Cells(2, 4).Value
'Company = Worksheets("Data").Cells(CompanyListLocation, 1).Value
For x = 2 To 1000000
If Worksheets("Data").Cells(x, 5).Value = CompanyListLocation Then
Worksheets("Data").Cells(x, 5).Copy
Worksheets("Workings").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Worksheets("Data").Cells(x, 14).Copy
Worksheets("Workings").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Worksheets("Data").Cells(x, 15).Copy
Worksheets("Workings").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
Next x
End Sub
Are you trying to copy all the data from Data Sheet in column A of Workings Sheet?
You may try something like below. Tweak it if required.
Sub CopyData()
Dim wsCriteria As Worksheet, wsData As Worksheet, wsDest As Worksheet
Dim CompanyListLocation
Dim lr As Long, dlr As Long
Application.ScreenUpdating = False
Set wsCriteria = Sheets("Dashboard")
Set wsData = Sheets("Data")
Set wsDest = Sheets("Workings")
CompanyListLocation = wsCriteria.Range("D2").Value
lr = wsData.UsedRange.Rows.Count
dlr = wsDest.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsData.AutoFilterMode = False
With wsData.Rows(1)
.AutoFilter field:=5, Criteria1:=CompanyListLocation
If wsData.Range("E1:E" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
wsData.Range("E2:E" & lr).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A" & Rows.Count).End(3)(2)
wsData.Range("N2:N" & lr).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A" & Rows.Count).End(3)(2)
wsData.Range("O2:O" & lr).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A" & Rows.Count).End(3)(2)
End If
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub
If you want to copy values only, change the copy paste code to this...
If wsData.Range("E1:E" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
wsData.Range("E2:E" & lr).SpecialCells(xlCellTypeVisible).Copy
wsDest.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
wsData.Range("N2:N" & lr).SpecialCells(xlCellTypeVisible).Copy
wsDest.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
wsData.Range("O2:O" & lr).SpecialCells(xlCellTypeVisible).Copy
wsDest.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
End If
What this does now is take whats inputted Columns A:E and add whatever you list in column F, at the end of it, keeping A:E constant. This makes it much easier rather than copying and pasting but i want to add another row so that A:F is constant, switching the list to column G.
For ex, once it's outputted,
A1,B1,C1,D1,E1,F1
A1,B1,C1,D1,E1,F2
A1,B1,C1,D1,E1,F3
etc.
I just want to add another column to make it
A1,B1,C1,D1,E1,F1,G1
A1,B1,C1,D1,E1,F1,G2
A1,B1,C1,D1,E1,F1,G3
This is what I have so far.
Dim LastRowIput As String
With Sheets("Input")
LastRowInput = .Cells(.Rows.Count, "C").End(xlUp).Row
End With
For I = 2 To LastRowInput
Dim LastRowLoc As String
With Sheets("Output")
LastRowLoc = .Cells(.Rows.Count, "F").End(xlUp).Row + 1
End With
Sheets("Input").Select
Range("F2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Output").Select
Range("F" & LastRowLoc).Select
ActiveSheet.Paste
Sheets("Input").Select
Range("A" & I & ":" & "E" & I).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Output").Select
Dim LastRow As String
With ActiveSheet
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
End With
Range("A" & LastRow).Select
ActiveSheet.Paste
Dim LastRowLoc2 As String
With Sheets("Output")
LastRowLoc2 = .Cells(.Rows.Count, "F").End(xlUp).Row
End With
Application.CutCopyMode = False
Range("A" & LastRow & ":" & "E" & LastRowLoc2).Select
Selection.FillDown
Sheets("Input").Select
Next I
It seems that you want to copy the rows from A:G from Input to Output, expanding A:F in Output for every row in G.
Dim i As Long, lastRowInput As Long, nextRowOutput As Long
Dim wso As Worksheet
Set wso = Worksheets("Output")
With Sheets("Input")
lastRowInput = .Cells(.Rows.Count, "C").End(xlUp).Row
For i = 2 To lastRowInput
nextRowOutput = wso.Cells(.Rows.Count, "G").End(xlUp).Row + 1
.Range(.Cells(2, "G"), .Cells(2, "G").End(xlDown)).Copy _
Destination:=wso.Cells(nextRowOutput, "G")
.Range("A" & i & ":" & "F" & i).Copy _
Destination:=wso.Range(wso.Cells(nextRowOutput, "A"), _
wso.Cells(wso.Cells(.Rows.Count, "G").End(xlUp).Row, "F"))
Next i
End With
I've removed all methods involving the Range .Select and Range .Activate methods in favor of direct referencing.
Sample data from Input worksheet
Sample results from Output worksheet
The below code seeks to pull the value from a cell in the the 'Input' sheet, and then display it in the 'Output' sheet. It then shows the difference between the last value recorded and expresses the figure as a percentage.
When I run this code with the Output sheet active it works. However, when I run it from the output sheet it doesn't. Instead, it displays the value I wish to copy in column F in the input sheet and displays the difference and percentage difference in the wrong cells in the Output sheet.
It looks correctly referenced to me, but it obviously isn't. Thoughts on how to correct?
I appreciate that the code could be tidier - i'm very new to this.
Sub Button1_Click()
Dim LastRow As Long
Dim RecentRow As Long
With Sheets("Output")
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
RecentRow = .Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0).Row
Range("F" & LastRow).Select
ActiveCell.Offset(1, 0).Formula = "=Input!B4"
ActiveCell.Offset(1, 0).Copy
ActiveCell.Offset(1, 0).PasteSpecial (xlValues)
End With
ActiveCell.Offset(0, 1).Formula = "=(F" & RecentRow & "-F" & LastRow & ")"
ActiveCell.Offset(0, 2).Formula = "=((F" & RecentRow & "/F" & LastRow & ")-1)"
End Sub
Thanks.
The below code should fix your issue - it's because your Range("F" & LastRow).Select did not have a period before Range.
Sub Button1_Click()
Dim LastRow As Long
Dim RecentRow As Long
With Sheets("Output")
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
RecentRow = .Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0).Row
With .Range("F" & LastRow)
.Offset(1, 0).Formula = "=Input!B4"
.Offset(1, 0).Copy
.Offset(1, 0).PasteSpecial (xlValues)
.Offset(0, 1).Formula = "=(F" & RecentRow & "-F" & LastRow & ")"
.Offset(0, 2).Formula = "=((F" & RecentRow & "/F" & LastRow & ")-1)"
End With
End With
End Sub
Furthermore, you can gain a bit more efficiency in your code with the below:
Sub Button1_Click()
Dim LastRow As Long
With ThisWorkbook.Sheets("Output") 'Allow for code to work even if in another workbook.
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
With .Range("F" & LastRow)
.Offset(1, 0).Value2 = ThisWorkbook.Sheets("Input").Range("B4").Value2
.Offset(0, 1).Formula = "=(F" & LastRow + 1 & "-F" & LastRow & ")"
.Offset(0, 2).Formula = "=((F" & LastRow + 1 & "/F" & LastRow & ")-1)"
End With
End With
End Sub
I want this script to check the cells on column A if there is a URL-link in them, and if it is true then perform some cut-paste operations.
String #5 returns error 404, please help to solve this!
Sub xxxxxx()
Worksheets("1 (2)").Activate
For i = 1 To 2200
Range("A" & i).Select
If (cell.Range("A1").Hyperlinks.Count >= 1) Then
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Cut
ActiveCell.Offset(-1, 2).Range("A1").Select
ActiveSheet.Paste
End If
Next i
End Sub
Per #Siddharth Rout post about not using Activate/Select, I've rewritten your code below. No need to check hyperlinks inside the loop every time since it's always checking cell A1
Sub xxxxxx()
Dim ws As Worksheet
Set ws = Worksheets("1 (2)")
Dim LastRow As Long
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
If (ws.Range("A1").Hyperlinks.Count > 0) Then
For i = 2 To LastRow
Range("A" & i).Offset(-1, 2).Value = Range("A" & i).Value
Range("A" & i).Clear
Next i
End If
End Sub
I am trying to Fill a formula that I have in D1 and fill down D to the length of C. I am using the follwing macro and I am getting the following error - Compile Error: Expected end with
Sub Macro3()
Macro3 Macro
Range("D1").Select
ActiveCell.FormulaR1C1 = "=RC[-2]*(-1)+RC[-1]"
Range("D1").Select
Dim LastRow As Long
With Sheets("Sheet2")
LastRow = Range("C" & Rows.Count).End(xlUp).Row
Range("D1").AutoFill Destination:=Range("D2:D" & LastRow)
End Sub
Your problem was a simple one. I used the macro recorder to AutoFill a Formula Range and found that the Destination Range starts with the Formula Range, so
Range("D1").AutoFill Destination:=Range("D2:D" & LastRow)
Should be:
Range("D1").AutoFill Destination:=Range("D1:D" & LastRow)
Here is working code, both fixed and cleaned up a bit :)
Sub Macro3()
With Sheets("Sheet1")
Dim LastRow As Long
LastRow = Range("C" & Rows.Count).End(xlUp).Row
With Range("D1")
.FormulaR1C1 = "=RC[-2]*(-1)+RC[-1]"
.AutoFill Destination:=Range("D1:D" & LastRow)
End With
End With
End Sub