I have this script that I had help with already, but now comes an issue. I am attempting to paste only the value, not the formula that is inside the cell to another cell.
I thought placing the .Value at the end of formula would tell the script to paste only the value... it seems not to be. Can someone give me a suggestion on how to make this work?
Option Explicit
Sub ONJL()
Dim lastrow As Long
Dim wsPAR As Worksheet 'PAERTO
Dim wsRD As Worksheet 'Raw Data
Dim wsTEM As Worksheet 'Archive
Set wsPAR = Sheets("PAERTO")
Set wsRD = Sheets("Raw Data")
Set wsTEM = Sheets("Template")
With wsRD
Application.ScreenUpdating = False
lastrow = .Range("J" & .Rows.Count).End(xlUp).Row
wsRD.Range("J" & lastrow + 1).Formula = Date
wsRD.Range("B2").Copy wsRD.Range("K" & lastrow + 1).Value
wsRD.Range("B3").Copy wsRD.Range("L" & lastrow + 1).Value
wsRD.Range("E2").Copy wsRD.Range("M" & lastrow + 1).Value
wsRD.Range("E3").Copy wsRD.Range("N" & lastrow + 1).Value
wsRD.Range("H2").Copy wsRD.Range("O" & lastrow + 1).Value
wsRD.Range("H3").Copy wsRD.Range("P" & lastrow + 1).Value
wsRD.Range("Q1:T1").Copy wsRD.Range("Q" & lastrow + 1)
Application.ScreenUpdating = False
End With
End Sub
You can "copy" without actually using .Copy like this:
Sub CopyWithoutCopying()
Dim wsRD As Worksheet
Dim lastrow As Long
Set wsRD = Sheets("Raw Data")
With wsRD
lastrow = .Range("J" & .Rows.Count).End(xlUp).Row
.Range("K" & lastrow + 1).Value = .Range("B2").Value
.Range("L" & lastrow + 1).Value = .Range("B3").Value
' etc...
End With
End Sub
This approach doesn't use your clipboard, performs better, and doesn't select anything. And as Jimmy points out, you don't need the wsRD prefix inside the With block.
Related
Trying to copy account numbers and instances of a transaction from 2 columns (Columns "C" and "D", beginning at row 13) in a selected workbook to my workbook, but only if the value in Column D is greater than 1. Also, the last row in the column is labeled "Grand Total", so obviously I want to not included that row.
So far, this is what I have:
Private Sub CmdGetData_Click()
Dim wb As Workbook, wb2 As Workbook
Dim NewFile As Variant
Dim ws As Worksheet, ws2 As Worksheet
NewFile = Application.GetOpenFilename("Excel-files (*.xlsx*, *.xlsx*")
If NewFile <> False Then
Set wb = ThisWorkbook
Set wb2 = Workbooks.Open(NewFile)
End If
Set ws = Worksheets("Main")
Set ws2 = wb2.Worksheets("IVR Late Fee Clean Up")
lastrow1 = ws.Cells(Rows.Count, 2).End(xlUp).Row
For i = 13 To lastrow2
lastrow2 = wb2.ws2.Cells(Rows.Count, 3).End(xlUp).Row
If wb2.ws2.Range("C" & i).Value = "Grand Total" Then GoTo Skip
If wb2.ws2.Range("D" & i).Value = "2" Then
wb.ws.Range("B" & lastrow1 + 1).Value = wb2.ws2.Range("C" & i)
wb.ws.Range("C" & lastrow1 + 1).Value = wb2.ws2.Range("D" & i)
End If
Next i
Skip:
End Sub
The problem I am getting is "Run-time error '9': Subscript out of range".
Please help!
1.
If wb2.ws2.Range("C" & i).Value = "Grand Total" Then GoTo Skip
needs to be:
If ws2.Range("C" & i).Value = "Grand Total" Then GoTo Skip
2. Also,
wb.ws.Range("B" & lastrow1 + 1).Value = wb2.ws2.Range("C" & i)
needs to be:
ws.Range("B" & lastrow1 + 1).Value = ws2.Range("C" & i)
etc...
3. And, one last thing, you have a For loop:
For i = 13 To lastrow2
But, you never set a value for lastrow2 up to this point, only at the following line you have:
lastrow2 = wb2.ws2.Cells(Rows.Count, 3).End(xlUp).Row
So you need to move that up 2 lines of code.
Modified Code
Option Explicit
Private Sub CmdGetData_Click()
Dim wb As Workbook, wb2 As Workbook
Dim NewFile As Variant
Dim ws As Worksheet, ws2 As Worksheet
Dim lastrow1 As Long, lastrow2 As Long, i As Long
NewFile = Application.GetOpenFilename("Excel-files (*.xlsx*, *.xlsx*")
If NewFile <> False Then
Set wb = ThisWorkbook
Set wb2 = Workbooks.Open(NewFile)
'====== ALL this code below needs to be inside the If NewFile <> False Then part =====
Set ws = wb.Worksheets("Main")
Set ws2 = wb2.Worksheets("IVR Late Fee Clean Up")
lastrow1 = ws.Cells(Rows.Count, 2).End(xlUp).Row
lastrow2 = ws2.Cells(Rows.Count, 3).End(xlUp).Row
For i = 13 To lastrow2
If ws2.Range("C" & i).Value = "Grand Total" Then Exit For
If ws2.Range("D" & i).Value = "2" Then
ws.Range("B" & lastrow1 + 1).Value = ws2.Range("C" & i).Value
ws.Range("C" & lastrow1 + 1).Value = ws2.Range("D" & i).Value
End If
Next i
End If
End Sub
Thank you all for your input. The code below worked! (Thank you #ShaiRado)
Private Sub CmdGetData_Click()
Dim wb As Workbook, wb2 As Workbook
Dim NewFile As Variant
Dim ws As Worksheet, ws2 As Worksheet
NewFile = Application.GetOpenFilename("Excel-files (*.xlsx*, *.xlsx*")
If NewFile <> False Then
Set wb = ThisWorkbook
Set wb2 = Workbooks.Open(NewFile)
End If
Set ws = wb.Sheets("Main")
Set ws2 = wb2.Sheets("IVR Late Fee Clean Up")
lastrow1 = ws.Cells(Rows.Count, 2).End(xlUp).Row
lastrow2 = ws2.Cells(Rows.Count, 3).End(xlUp).Row
For i = 13 To lastrow2
If ws2.Range("C" & i).Value = "Grand Total" Then GoTo Skip
If ws2.Range("D" & i).Value = "2" Then
ws.Range("B" & lastrow1 + 1).Value = ws2.Range("C" & i)
ws.Range("C" & lastrow1 + 1).Value = ws2.Range("D" & i)
End If
Next i
Skip:
End Sub
And #Ryszard: I didn't get the debug option because I was running from the script editor, not the actual command button. My mistake.
I would like to copy data from sheet INV_LEDGERSinto Ready to uploadsheet, but the sheet Ready to upload already contains some data and therefore I want to loop through the column A in Ready to upload sheet until it will find the blank cell and then paste the data from INV_LEDGERS.
Sub CopyLedgers()
Dim ws As Worksheet, ws1 As Worksheet
Dim LastRow As Long
Set ws = Sheets("INV_LEDGERS")
Set ws1 = Sheets("Ready to upload")
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To LastRow
If ws.Range("A" & i) > "" And ws1.Range("A" & i + 1) = "" Then
ws.Range("A" & i & ":AE" & i).Copy
ws1.Range("A" & i + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Else
End If
Next
End Sub
It doesnt show the error msg anymore, but now it copies the data from INV_LEDGERSfrom the row, where data on sheet Ready to upload ends. I mean, that if data on Ready to upload has the end on row 82, the code will take the data from INV_LEDGERS from 82. row, so basically there are missing 81 rows.
Could you advise me, please?
Thanks a lot!
Given the comments from braX, here is my code.
Since you are always starting on the 4th row of the ledger data, you can just copy the entire section and then paste it to your last row + 1 on your upload sheet.
Sub CopyLedgers()
Dim ws As Worksheet, ws1 As Worksheet
Dim LastRow, LRow As Long
Set ws = Sheets("INV_LEDGERS")
Set ws1 = Sheets("Ready to upload")
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
LRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
ws.Range("A4:AE" & LastRow).Copy
ws1.Range("A" & LRow + 1).PasteSpecial xlPasteValues
End Sub
Couple things... have used a With statement, and instead of copy/paste, I'm just making ws1.Value=ws.Value:
Sub CopyLedgers()
Dim ws As Worksheet, ws1 As Worksheet, LastRow As Long
Set ws = Sheets("INV_LEDGERS")
Set ws1 = Sheets("Ready to upload")
With ws
LastRow = .Cells( .Rows.Count, 1).End(xlUp).Row
For i = 4 To LastRow
If .Range("A" & i) > "" And ws1.Range("A" & i + 1) = "" Then
ws1.Range("A" & i + 1 & ":AE" & i + 1).Value = .Range("A" & i & ":AE" & i).Value
End If
Next
End With
End Sub
Edit
Sub CopyLedgers()
Dim ws As Worksheet, ws1 As Worksheet, LastRow As Long
Set ws = Sheets("INV_LEDGERS")
Set ws1 = Sheets("Ready to upload")
With ws
LastRow = .Cells( .Rows.Count, 1).End(xlUp).Row
For i = 4 To LastRow
If IsEmpty(ws1.Range("A" & i + 1)) Then
ws1.Range("A" & i + 1 & ":AE" & i + 1).Value = .Range("A" & i & ":AE" & i).Value
End If
Next
End With
End Sub
I am writing a macro in Excel. Part of the code finds the cell that has "Attached Packaging" in it and then deletes the contents of a group of cells surrounding that cell.
Here is the code that currently achieves this:
Cells.Find("Attached Packaging").Activate
ActiveCell.Resize(2, 4).Select
Selection.Clear
ActiveCell.Offset(1, -1).Select
Selection.Clear
My problem now is that I, unexpectedly, have multiple cells with "Attached Packaging" in them which now also have to be deleted.
So, to summarize: I need to modify this code so It finds all "Attached Packaging" cells in a spreadsheet and deletes the group around them.
Sub clear()
Dim ws As Worksheet
Dim search As String
Dim f As Variant
Dim fRow As Long
Dim fCol As Long
search = "Attached Packaging"
Set ws = ThisWorkbook.Worksheets("Sheet4") 'change sheet as needed
With ws.Range("A1:AA1000") 'change range as needed
Set f = .Find(search, LookIn:=xlValues)
If Not f Is Nothing Then
Do
fRow = f.Row
fCol = f.Column
ws.Range(Cells(fRow, fCol), Cells(fRow + 1, fCol + 3)).clear
ws.Cells(fRow + 1, fCol - 1).clear
Set f = .FindNext(f)
Loop While Not f Is Nothing
End If
End With
End Sub
Sub clearCells()
Dim ws As Worksheet
Dim lastrow As Long, currow As Long
Dim critvalue As String
Set ws = Sheets("Sheet1")
' Change A to a row with data in it
lastrow = ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row - 1
'Change 2 to the first row to check
For currow = 2 To lastrow
critvalue = "Attached Packaging"
' Change A to the row you are looking in
If ws.Range("A" & currow).Value = critvalue Then
' Use the currow to select the row and then create an offset
ws.Range("A" & currow).offset("B" & currow - 1).clear
ws.Range("A" & currow).offset("B" & currow + 1).clear
End If
Next currow
End Sub
Make the changes needed where I commented. It should work.
I am trying to write a change log for excel VBA. I want it to iterate through so that the each additional response is populated in the workbook as the additional rows. Please let me know if you have any insight into what is wrong with my code
Dim streply As String
Dim Today As Date
Dim myrange As Range
Dim inglastrow As Long
CurrentDate = Date
With Sheets("Sheet1")
lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
nextrow = lastrow + 1
MsgBox lastrow
MsgBox nextrow
End With
MsgBox lastrow
streply = InputBox(Prompt:="Please type description of changes", Title:="Change Log", Default:="Brief Desc.")
If streply <> " " Then
Range("A" & nextrow).Value = Application.UserName
Range("B" & nextrow).Value = streply
Range("C" & nextrow).Value = ActiveWorkbook.Name
Range("D" & nextrow).Value = Date
End If
Set lastrow = Nothing
Set nextrow = Nothing
End Sub
EDIT: silly mistake on my part, fixed now
Instead of:
lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
Try:
lastrow = .UsedRange.Rows.Count
I have the following code. I was wondering if there is an easy way to rewrite it so that it takes less time to run? Currently, I have about 13,000 rows to loop through and it takes approximate 3-5 minutes to run. Thanks!
Sheets("wkly").Activate
Dim i As Long
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Lastrow
If Range("S" & i) > 0.005 Then
Range("Z" & i, "AA" & i).Copy
Range("AC" & i, "AD" & i).PasteSpecial xlPasteValues
End If
Application.ScreenUpdating = False
Next i
I believe this will help make it a lot faster. No looping and no copy and paste needed.
Application.ScreenUpdating = False
Application.Calculation = xlManual
Dim wks As Worksheet, Lastrow As Long
Set wks = Sheets("wkly")
With wks
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("S1:S" & Lastrow).AutoFilter 1, ">.005"
'Assumes you will always have values greater than .005, if not you need to error trap
Dim rngFilter As Range
Set rngFilter = .Range("S2:S" & Lastrow).SpecialCells(xlCellTypeVisible) 'assumes row 1 is header row
rngFilter.Offset(, 10).Value = rngFilter.Offset(, 7).Value
rngFilter.Offset(, 11).Value = rngFilter.Offset(, 8).Value
End With
Application.ScreenUpdating = True
UPDATE
I know you accepted the answer already, but in case you want to know how to do this by using an array to loop through, here it is below:
Dim wks As Worksheet, varStore As Variant, Lastrow As Long, i As Long
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set wks = Sheets("wkly")
With wks
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
varStore = .Range("S2:S" & Lastrow)
For i = LBound(varStore, 1) To UBound(varStore, 1)
If varStore(i, 1) > 0.005 Then .Range("AC" & i + 2 & ":AD" & i + 2).Value = .Range("Z" & i + 2 & ":AA" & i + 2).Value
Next
End With
Application.ScreenUpdating = False
If you do operations on a large number of cells, copying them into an array and writing them back after the processing is usually the fastest. The following code runs in 0.04s on my machine (based on Scott's answer, but using arrays also for the writing):
Dim wks As Worksheet
Dim varCompare As Variant, varSource As Variant, varTarget As Variant
Dim Lastrow As Long, i As Long
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set wks = Sheets("wkly")
With wks
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
varCompare = .Range("S2:S" & Lastrow)
varSource = .Range("Z2:AD" & Lastrow)
varTarget = .Range("AC2:AD" & Lastrow)
For i = LBound(varCompare, 1) To UBound(varCompare, 1)
If varCompare(i, 1) > 0.005 Then
varTarget(i, 1) = varSource(i, 1)
varTarget(i, 2) = varSource(i, 2)
End If
Next
.Range("AC2:AD" & Lastrow).Value = varTarget
End With
Application.ScreenUpdating = False
Given all the good tips, and include the following too. Please give a try and see how much performance boost you could achieve.
Application.Calculation = xlCalculationManual
lastrow = Range("S" & Rows.Count).End(xlUp).Rows
For i = 1 To lastrow
If Range("S1").Offset(i) > 0.005 Then
Range("AC").Offset(i).Resize(1, 2).Value = Range("Z").Offset(i).Resize(1, 2).Value
End If
Next i