PasteValues is the most frustrating thing in VBA! Could greatly use some help.
In short, I am trying to copy one row and pastespecial values that row into another row on a separate sheet. I thought it was a row issue, so I then modified my range and tried pasting that, also to no avail. I even tried recording a macro and the generated code is almost the exact same as mine.
Can someone please help? I've been looking at this too long :/
Sub CopyXs()
Dim counter As Double
Dim CopyRange As String
Dim NewRange As String
counter = 2
For Each Cell In ThisWorkbook.Sheets("LD_Tracker_CEPFA").Range("A7:A500")
If Cell.Value = "X" Then
Sheets("Upload_Sheet").Select
matchrow = Cell.Row
counter = counter + 1
Let CopyRange = "A" & matchrow & ":" & "Y" & matchrow
Let NewRange = "A" & counter & ":" & "Y" & counter
Range(CopyRange).Select
Selection.Copy
Sheets("Final_Upload").Select
ActiveSheet.Range(NewRange).Select
Selection.PasteSpecial Paste = xlPasteValues
Sheets("Upload_Sheet").Select
End If
Next
End Sub
I was struggling also with Paste.Special. This code works for me. The code you get when you record a macro for Paste.Special is not working. You first have to define a range and then used the code for Paste.Special
Range(something).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'This code works for me:
'**Select everything on the active sheet**
Range("A1").Select
Dim rangeTemp As Range
Set rngTemp = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not rngTemp Is Nothing Then Range(Cells(4, 1), rngTemp).Select
End if
' **Copy the selected range**
Selection.Copy
'**Select the destination and go to the last cel in column A and then go 2 cells down
'and paste the values**
Sheets("your sheet name").Select
Range("A" & Cells.Rows.Count).End(xlUp).Offset(2, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
**'Select the last cell in column A**
Range("A" & Cells.Rows.Count).End(xlUp).Select
Related
I've been working on this for a bit, and I've just come to a roadblock. I'm trying to format some data for graphing in Excel, and it looks like this:
Example Data
I'd like to have the output look like this:
Desired Output
The actual number of faults and days vary wildly, so it has to be open-ended, so it can do a full search of the imported file. I'm trying to do it using VBA without relying on a formula.
Let me know if there's anything I could be doing different.
Here's the code:
Sub Graph()
Dim GraphDataWS, DataWS, FormWS As Worksheet
Dim criteria1, InspectedMtr As String
Dim totalrow, ErrorRangevar, DateRangeVar, Row1, Col1 As Long
Dim Daterange, ErrorRange As Range
Dim criteria2 As Variant
Dim ErrorCount, Output As Double
Worksheets("Graph Data").Activate
Set Worksheet = ActiveWorkbook.Sheets("Graph Data")
Cells.Select
Selection.ClearContents
Selection.ClearContents
Set GraphDataWS = ActiveWorkbook.Sheets("Graph Data")
Set FormWS = ActiveWorkbook.Sheets("Formulas")
Set DataWS = ActiveWorkbook.Sheets("Data")
totalrow = FormWS.Range("A21").Value
Worksheets("Data").Range("A1:A" & totalrow).SpecialCells(xlCellTypeVisible).Copy (Worksheets("Graph Data").Range("B1"))
Worksheets("Data").Range("E1:E" & totalrow).SpecialCells(xlCellTypeVisible).Copy (Worksheets("Graph Data").Range("A1"))
With GraphDataWS
ErrorRangevar = GraphDataWS.Cells(Rows.Count, "A").End(xlUp).Row
GraphDataWS.Range("A1:A" & ErrorRangevar).Copy (GraphDataWS.Range("C1:C" & ErrorRangevar))
GraphDataWS.Range("C2:C" & ErrorRangevar).RemoveDuplicates Columns:=1
DateRangeVar = GraphDataWS.Cells(Rows.Count, "B").End(xlUp).Row
GraphDataWS.Range("B1:B" & DateRangeVar).Copy (GraphDataWS.Range("D1:D" & DateRangeVar))
GraphDataWS.Range("D2:D" & DateRangeVar).RemoveDuplicates Columns:=1
'DateRangeVar = GraphDataWS.Cells(Rows.Count, "B").End(xlUp).row
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
ErrorRangevar = ErrorRangevar + 2
Worksheets("Graph Data").Activate
Output = 0
Set Daterange = GraphDataWS.Range(Cells(1, 4), Cells(1, DateRangeVar))
Set ErrorRange = GraphDataWS.Range("C1:C" & ErrorRangevar)
For a = 2 To ErrorRangevar
criteria1 = Cells(a, 3).Value
For b = 2 To ErrorRangevar
criteria2 = Cells(a, 4).Value
For i = 2 To ErrorRangevar
If ((Cells(i, 1)) = criteria1) And (Cells(i, 2) = criteria2) Then
Output = Output + 1
End If
Next i
Row1 = ErrorRange.Find(What:=criteria1).Row
Col1 = Daterange.Find(What:=criteria2).Column
Cells(Row1, Col1).Value = Output
MsgBox criteria1 & " " & Row1 & " " & criteria2 & " " & Col1 & " Output: " & Output
Output = 0
Next b
Next a
GraphDataWS.Range("E2").Value = Output
End With
End Sub
Any other suggestions or comments are welcome, I'm still learning VBA/Excel. Thank you!
First, I'm sorry as I can't understand this sentence :
to graph information from that
porting the information from a table
Anyway, other than create a pivot table from the data seen in your first image to get the expected result as seen in your second image ... I try to make the code based on the data seen in your first image to get the expected result as seen in you second image.
Sub test()
Dim rgdt As Range: Dim dateCol As Range: Dim cell As Range
Dim rgdt1 As String: Dim rgdt2 As String
Set rgdt = Sheets("Sheet1").UsedRange
Set rgdt = rgdt.Resize(rgdt.Rows.Count - 1, rgdt.Columns.Count).Offset(1, 0)
rgdt1 = "Sheet1!" & rgdt.Columns(1).Address
rgdt2 = "Sheet1!" & rgdt.Columns(2).Address
With Sheets("Sheet2").Range("A1")
.Value = "NAME"
rgdt.Copy Destination:=.Offset(1, 0)
.Range(rgdt.Columns(1).Address).RemoveDuplicates Columns:=1, Header:=xlNo
.Range(rgdt.Columns(2).Address).RemoveDuplicates Columns:=1, Header:=xlNo
Set dateCol = .Range(rgdt.Columns(2).Address).SpecialCells(xlConstants)
dateCol.Copy
.Offset(0, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
dateCol.Clear
For Each cell In .Range(rgdt.Columns(1).Address).SpecialCells(xlConstants)
With cell.Offset(0, 1).Resize(1, dateCol.Rows.Count)
.Value = "=countifs(" & rgdt1 & "," & cell.Address & "," & rgdt2 & ",B$1)"
.Value = .Value
.Replace What:=0, Replacement:="", MatchCase:=True
End With
Next
End With
End Sub
The sub assumed that there is nothing else in "Sheet1" but the data seen in your example data image.
First it create rgdt variable as the range of the data in "Sheet1" (sheet "Data" in your case, so change accordingly) without including the header.
Then it create rgdt1 and rgdt2 string variable to point which sheet and which column of rgdt.
Then it prepares the "skeleton" of expected result in "Sheet2" (Sheet "Graph Data" in your case):
fill cell A1 with "NAME"
copy the rgdt to cell A1.offset(1,0)
remove duplicate value in column A
remove duplicate value in column B
set the range of column B with data as dateCol variable (without the header)
copy the dateCol and paste transpose to cell A1.offset(0,1)
clear the value in dateCol
Next, it populate the value for the expected count result by looping to each cell which has value in column A, where on each loop it fill the range of cells after the looped cell to the right with COUNTIFS formula, remove the formula as value, then replace zero (0) result with nothing.
If you want to test the sub, create a new workbook, copy your data into cell A1 of "Sheet1", copy also the sub, then run the sub. See the expected result in "Sheet2".
The following code is working in my mind but not in vba:
Dim i As Integer
If Range("H11") = i Then Range("U" & i & ":X" & i).Select
Selection.Copy
lrij = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & lrij + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("H11").ClearContents
Range("A1").Activate
i is a variable row number.
The purpose is if I enter "2" for example in Cell "H11", the Range ("U2:X2") will be copy pasted in Column "A", row under row.
braX already helped me with writing the variable range correctly, but I'm lacking the point here I guess. He advised me to use the "Long" data type.
Thank you in advance.
I have this code running smoothly when I step through the code (F8), but when I run it with F5 or call it to run from a button it doesn't do what it's supposed to. It only does the lookup in the first cell (Q2) and leaves the rest blank - like it skipped to run the formula down to the last row.
How can I improve my code to make sure that it always runs as it should?
Sub LookupFilename()
' Looks up the filename to be set according to Team Name
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],Controller!C9:C12,4,FALSE),""Other"")"
Range("Q2").AutoFill Destination:=Range("Q2:Q" & LastRow)
Application.ScreenUpdating = True
MsgBox "Successful data collection.", vbInformation, "Success"
End Sub
There is no need to Select or use ActiveCell or AutoFill. Replace:
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],Controller!C9:C12,4,FALSE),""Other"")"
Range("Q2").AutoFill Destination:=Range("Q2:Q" & LastRow)
with:
Range("Q2:Q" & LastRow).FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],Controller!C9:C12,4,FALSE),""Other"")"
Note, you shouldn't be Activateing either. Instead, qualify your Range, Cells, and Rows calls with the appropriate worksheet. Note the . before Cells, Rows and Range below:
Dim Data As Worksheet
Set Data = ThisWorkbook.Worksheets("Data")
With Data
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("Q2:Q" & LastRow).FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],Controller!C9:C12,4,FALSE),""Other"")"
End With
I have a constant task at work where I need to copy a list of numbers to another sheet. In that sheet, I need to paste those numbers one by one, in a cell to the right of cells with a certain value(that repeats in a column). (notice that the target table is sorted by that value -"מודל תגובה" and there are hidden rows.
It's hard to explain so I hope the images will do.
I tried to write suitable code but I kept getting different errors.
It seems that problems occur when copying the cell values to the target cells.
Dim i As Integer
i = 4
Do While IsEmpty(Cells(i, 1).Value) = False
Worksheets(1).Select
Cells(i, 1).Copy
Worksheets(2).Select
Cells.Find(What:="מודל תגובה", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, -1).Activate
If IsEmpty(ActiveCell.Value) = False Then
Selection.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, -1).Paste
Else
ActiveCell.Offset(0, -1).Select
ActiveCell.Paste
End If
i = i + 1
Loop
sorry for the shitty code(literally my first macro).
The solution would be to loop through the visible cells of the filtered range only.
Make sure the destination is filtered for "מודל תגובה" before running this code. It needs to look like your second image before running this code.
Dim SourceSheet As Worksheet
Set SourceSheet = Worksheets(1)
Dim DestinationSheet As Worksheet
Set DestinationSheet = Worksheets(2)
Dim LastRow As Long
LastRow = DestinationSheet.Cells(DestinationSheet.Rows.Count, "B").End(xlUp).Row
Dim VisibleCells As Range
On Error Resume Next 'next line errors if no visible cells so we turn error reporting off
Set VisibleCells = DestinationSheet.Range("A2", "A" & LastRow).SpecialCells(xlCellTypeVisible)
On Error Goto 0 'turn error reporting on or you won't see if other errors occur
If VisibleCells Is Nothing Then 'abort if no cells are visible in the filter
MsgBox "No cells to paste at"
Exit Sub
End If
Dim SourceRow As Long
SourceRow = 4 'start row in your source sheet
Dim Cell As Range
For Each Cell In VisibleCells.Cells 'loop through visible cells
Cell.Value = SourceSheet.Cells(SourceRow, "A").Value 'copy value
SourceRow = SourceRow + 1 'incerease source row
Next Cell
Make sure to define DestinationSheet and SourceSheet with your sheets names.
Try this:
Dim i As Integer
Dim Last_Row as Long
Worksheets(1).Select
'The "1" Of the line below means that the variable gonna count the rows of the first column (A)
Last_Row = Application.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:A" & Last_Row).Copy
Worksheets(2).Select
Range("A1").Select
ActiveSheet.Paste
I'm looking to 'normalize' a column of data by setting the minimum value to 0 and shifting the entire column's data by the difference of the min value and 0.
The code should be simple, but I can't find the appropriate range selection to stop the code when it reaches a blank cell.
Below is the core that I've unsuccessfully been working off of trying to recognize the first empty cell in column U after U9 up to U700 and correspondingly stop subtracting in column Z. Example screenshots are attached. Thank you!
Private Sub CommandButton1_Click()
[Z9:Z700] = [U9:U700-U8]
End Sub
This is what I get:
This is what I would like to get:
Try this:
Sub foo()
Dim lRow As Long
With ActiveSheet
lRow = .Cells(Rows.Count, "U").End(xlUp).Row
.Range("U9:U" & lRow).Copy .Range("Z9")
With .Range("U8")
.Formula = "=MIN(U9:U" & lRow & ")"
.Copy
End With
.Range("Z9:Z" & lRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlSubtract
Application.CutCopyMode = False
End With
End Sub
EDIT:
If you have formulas in Column U, below your list of numbers, which are returning blank values, then this revision might work better for you:
Sub foo2()
Dim lRows As Long
With ActiveSheet
lRows = WorksheetFunction.Count(.Range("U9:U700"))
.Range("U8").Formula = "=MIN(" & .Range("U9").Resize(lRows, 1).Address(0, 0) & ")"
.Range("U9").Resize(lRows, 1).Copy
.Range("Z9").PasteSpecial Paste:=xlPasteValues
.Range("U8").Copy
.Range("Z9").Resize(lRows, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlSubtract
End With
Application.CutCopyMode = False
End Sub