So I am new to this language and am trying to get my head around it. This piece of code is for work and the section here was hugely assisted by an amazing person on this website.
This piece should copy over a row of information to a different spreadsheet when the box in the I Column turns to 7. And thanks to that person it works pretty perfectly.
The next question on my mind though is how to the delete the original row in the first spreadsheet.
I can't use a range like "A9:M9" as the row will not always been in that fixed place.
I tried using:
If Source.Column = 9 And Source.Value = "7 - engaged" Then
Range("A:M").Select
Selection.ClearContents
But this wiped the entire worksheet.
Is there any way to just delete the one row that's been copied?
If Source.Column <> 9 Then Exit Sub
If Source.Value <> "7 - engaged" Then Exit Sub
If MsgBox("Client status selected as engaged. Confirm to post to tank.",
vbOKCancel) = vbOK Then
With ThisWorkbook.Worksheets("Tank")
Dim rowToPasteTo As Long
rowToPasteTo = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
.Range("A" & rowToPasteTo & ":" & "D" & rowToPasteTo).Value =
Sh.Range("A" & Source.Row & ":" & "M" & Source.Row).Value
.Range("G" & rowToPasteTo & ":" & "H" & rowToPasteTo).Value =
Sh.Range("E" & Source.Row & ":" & "F" & Source.Row).Value
.Range("S" & rowToPasteTo & ":" & "U" & rowToPasteTo).Value =
Sh.Range("K" & Source.Row & ":" & "M" & Source.Row).Value
End With
End If
If Source.Column = 9 And Source.Value = "7 - engaged" Then`
Not sure if you want to delete the entire row or clear the cells contents:
If Source.Column = 9 And Source.Value = "7 - engaged" Then
' Option 1 - deletes the entire row
Source.EntireRow.Delete
' Option 2 - clears the contents
Source.EntireRow.ClearContents
End Sub
Related
I'm copying rows of data from one spreadsheet to another on a button press when cell I says "Yes" and deleting the original row of data. I have multiple ranges I'm copying from the same row, because the second spreadsheet doesn't need all the data held in the first. (first spreadsheet has over 20 columns worth of data but the second has half that). Is there an easy way to make sure this all gets copied to the same row in the new spreadsheet?
Basically what I'm currently doing is copying each of the ranges to the corresponding column in the new spreadsheet with the row number set to being the last used row offset by 1. Which works fine if the previous cells actually have data in, but sometimes they don't (the data is on households and some have more data than others so not all columns are always filled) so the data is placed in a different row from the rest of my data for that particular household.
Private Sub CommandButton1_Click()
Dim c As Range
Dim r As Integer
Dim LastRowD
Dim LastRowR
Dim Database As Worksheet
Dim DeReg As Worksheet
'Set worksheet deignation as needed
Set Database = ActiveWorkbook.Worksheets("Fostering Households")
Set DeReg = ActiveWorkbook.Worksheets("De-Registrations")
LastRowD = Database.Cells(Database.Rows.Count, "A").End(xlUp).Row
'Searches all rows in I
For Each c In Database.Range("I1:I" & LastRowD)
'Catches cases where "Yes" is present in column I
If c = "Yes" Then
LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0)
r = c.Row
'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab
Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("H" & r).Copy DeReg.Range("AJ" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("J" & r & ":X" & r).Copy DeReg.Range("H" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("AN" & r).Copy DeReg.Range("W" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("AS" & r).Copy DeReg.Range("X" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("AZ" & r & ":BH" & r).Copy DeReg.Range("Y" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next c
For i = 250 To 1 Step -1
If Database.Range("I" & i) = "Yes" Then
Database.Rows(i).EntireRow.Delete
End If
Next i
End Sub
I've tried defining the last row based on whether "A" has data in (this is the only cell that is always used) with the code:
LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0) and then replacing my copy past code with:
Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR & ":B" & LastRowR).Row
But this didn't work at all - it copied the first row it found with "Yes" in infinitely and overwrote all the data already present.
I also tried:
Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR).PasteSpecial
which also came with a world of problems and errors.
What I want is to search for the last used Row based on what's in column A, offset by 1, and then past the data in the column I designate, rather than the last row used being defined by the column I'm trying to paste in - is this even doable? I can't seem to find any information on this particular issue.
Also, if there is a better way of handing multiple ranges that would be great as it seems rather convoluted currently!
DeReg.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) evaluates to:
DeReg.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Offset(1, 0), so unless DeReg is the activesheet, you will get the wrong range.
See if this helps:
.... other code
'LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0)
r = c.Row
'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab
With Database
LastRowR = DeReg.Range("A" & DeReg.Rows.Count).End(xlUp).Row + 1
.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR)
.Range("H" & r).Copy DeReg.Range("AJ" & LastRowR)
.Range("J" & r & ":X" & r).Copy DeReg.Range("H" & LastRowR)
.Range("AN" & r).Copy DeReg.Range("W" & LastRowR)
.Range("AS" & r).Copy DeReg.Range("X" & LastRowR)
.Range("AZ" & r & ":BH" & r).Copy DeReg.Range("Y" & LastRowR)
End With
End If
... other code
Some helpful tips:
i is not declared. Declare as Long.
LastRowR, r & LastRowD should be declared as Long.
Replace ActiveWorkbook with ThisWorkbook.
The copy paste method used may slow down the program, because this method copies and pastes both values and formatting.
When you want to paste in the line after last row, use +1 (Example: LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row +1
Just a couple thoughts. Firstly, you have declared multiple things that are unnecessary (IMO). I have adjusted your for loop to simply loop through a value that then references the range you want. This way you can use the i value a lot more efficiently than first setting a range and then looping through and referencing the row etc.
Additionally, based on the understanding I get from your post, if you use the .UsedRanged method your outputs will start at the last row on the new sheet, irregardless of your previously chosen method by column. I have not tested the below code, but it should guide you in a clearer way.
Option Explicit
Private Sub CommandButton1_Click()
Dim i As Long
Dim LastRowD As Long
Dim LastRowR As Long
Dim Database As Worksheet
Dim DeReg As Worksheet
'Set worksheet deignation as needed
Set Database = ActiveWorkbook.Worksheets("Fostering Households")
Set DeReg = ActiveWorkbook.Worksheets("De-Registrations")
LastRowD = Database.Cells(Database.Rows.Count, "A").End(xlUp).Row
'Searches all rows in I
For i = 1 To LastRowD
'Catches cases where "Yes" is present in column I
If Database.Range("I" & i) = "Yes" Then
LastRowR = Database.UsedRange.Rows.Count + 1
'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab
Database.Range("A" & i & ":G" & i).Copy DeReg.Range("A" & LastRowR)
Database.Range("H" & i).Copy DeReg.Range("AJ" & LastRowR)
Database.Range("J" & i & ":X" & i).Copy DeReg.Range("H" & LastRowR)
Database.Range("AN" & i).Copy DeReg.Range("W" & LastRowR)
Database.Range("AS" & i).Copy DeReg.Range("X" & LastRowR)
Database.Range("AZ" & i & ":BH" & i).Copy DeReg.Range("Y" & LastRowR)
End If
Next i
For i = 250 To 1 Step -1
If Database.Range("I" & i) = "Yes" Then
Database.Rows(i).EntireRow.Delete
End If
Next i
End Sub
I am using VBA to copy and paste a variable number of rows from one sheet to another when they meet a criteria.
This is working. However, when the data is pasted into the target sheet the column and row width change to be the same as the source sheet.
How can I stop this from happening? So that just the data is pasted, without the cell formatting.
If anyone knows it would be much appreciated.
Heres the code I'm using.
Sub copyOverdue()
Dim cell As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Set Source = ActiveWorkbook.Worksheets("Action Register")
Set Target = ActiveWorkbook.Worksheets("Sheet1")
j = 36 ' Paste to this number row
For Each cell In Source.Range("A7:A243")
If c = "Overdue" Then
Source.Range("A" & c.row & "," & "G" & c.row).Copy Target.Range("AD" & j)
Source.Range("C" & c.row & "," & "F" & c.row & "," & "H" & c.row & "," & "K" & c.row).Copy Target.Range("AF" & j)
j = j + 1
End If
Next cell
End Sub
You can pastespecial values only
For Each cell In Source.Range("A7:A243")
If cell.value = "Overdue" Then
cell.Resize(, 7).Copy
Target.Range("AD" & j).PasteSpecial xlValues
Source.Range("C" & cell.Row & "," & "F" & cell.Row & "," & "H" & cell.Row & "," & "K" & cell.Row).Copy
Target.Range("AF" & j).PasteSpecial xlValues
j = j + 1
End If
Next cell
You can also avoid the clipboard altogether and transfer the values directly, which is more efficient but it can get a bit mess you are dealing with large ranges.
Target.Range("AD" & j).Resize(,7).Value=cell.Resize(, 7).value
I have an excel VBA macro that transfers some data from one workbook to another. The workbook that the data is sent to is set up with 12 worksheets, each one representing a month. When the user initiates the macro, it determines which sheet to paste the data into from some of the data being transferred. I bring this up because the issue I am having is dependent on the sheet the data will be pasted to. Part of the macro is a do while loop that finds the next available row to paste the data to. This loop only activates on certain sheets. The loop is skipped in other sheets. (For example, the loop will activate if the data will be pasted into the December sheet but not the November sheet or the January Sheet.)
I have stepped through the macro two times. The first time I set the the data to be pasted to the december sheet and the loop worked correctly.
The second time I set the data to be pasted in the January sheet and the loop was skipped over.
With wbOut.Sheets(strSheet)
.Activate
nLastRowOut = .Range("A500").End(xlUp).Row + 1
i = 220
nLastRowOut = i
Do While (i > 41)
str = .Range("A" & i).Value & .Range("B" & i).Value & .Range("C" & i).Value & .Range("D" & i).Value & .Range("E" & i).Value & .Range("F" & i).Value & .Range("G" & i).Value & .Range("H" & i).Value & .Range("I" & i).Value & .Range("J" & i).Value & .Range("K" & i).Value & .Range("L" & i).Value & .Range("M" & i).Value
If Replace(str, 0, "") <> "" Then
nLastRowOut = i + 1
GoTo copySections
End If
i = i - 1
Loop
The next available row should be found and and then used to paste the data.
What is actually happening 75% of the time is that the loop is skipped over and the data is pasted in row 221 instead of the next available row.
The code for the nLastRowOut doesn't look right..
Change this:
nLastRowOut = .Range("A500").End(xlUp).Row + 1
to this:
nLastRowOut = .Range("A" & Rows.Count).End(xlUp).Row + 1
I automating a spreadsheet cleaning tools that removes data from the spreadsheet if certain values are in a particular column. Originally, it deleted entire rows of data if the specific value is found. However, this is causing numerous reference errors by deleting the rows. Sample of the original code below.
Set rData = .Range("L5:L" & last & ",AX5:AX" & last)
For i = rData.Row To rData.Row + rData.Rows.Count - 1
If .Range("AX" & i) = "DONE" Or .Range("AX" & i) = "CANCEL" Then
.Range("A" & i, "AX" & i).Copy
bottom = activewkb.Worksheets("OrderStatus").Range("I" & Rows.Count).End(xlUp).Row + 1
activewkb.Worksheets("OrderStatus").Range("A" & bottom).PasteSpecial Paste:=xlPasteValues
If i > 0 Then
.Range("D" & i & ":CA" & i).ClearContents
End If
End If
Next i
The easiest way to get rid of the reference errors is to clear the contents from column D through DD if the requirements are satisfied then shift all of the data below it up for column D to DD up one row. The new code is below. I am getting an error on the .Range("D" & i).Offset(1,0).Value line.
Set rData = .Range("L5:L" & last & ",AX5:AX" & last)
For i = rData.Row To rData.Row + rData.Rows.Count - 1
If .Range("AX" & i) = "DONE" Or .Range("AX" & i) = "CANCEL" Then
.Range("A" & i, "AX" & i).Copy
bottom = activewkb.Worksheets("OrderStatus").Range("I" & Rows.Count).End(xlUp).Row + 1
activewkb.Worksheets("OrderStatus").Range("A" & bottom).PasteSpecial Paste:=xlPasteValues
If i > 0 Then
.Range("D" & i & ":CA" & i).ClearContents
.Range("D" & i).Offset(1, 0).Value
.Offset(1, 0).Select
End If
End If
Next i
Any suggestions are appreciated! Thanks in advance.
UPDATE:
Got a new issue with a formula, can't quite get it to work because of text in the formula, the formula (as taken from excel) should be,
=IF(D2<=0,"No Sales Price",E2/D2)
I have tried as many combinations as I can think of but the "no sales price" is causing an issue with the quotation marks. My current code is
For i = 2 To LastRowG
Range("Q" & i).Formula = "=IF(D" & i & "<=0," & "(No Sales Price)", & "(E" & i & "/D" & i & "))"
Next i
have had a look around but been unable to see any resolutions to the problem, any enlightenment will be met with the greatest appreciation
EDIT:This was fixed by inserting the following lines;
For i = 2 To LastRowG
Range("Q" & i).Formula = "=IF(D" & i & "<=0," & Chr(34) & "No Sales Price" & Chr(34) & "," & "E" & i & "/" & "D" & i & ")"
Next i
The Chr(34) inserts the ASCII character appertaining to that number which just so happens to be ". The program doesn't read it as having typed in the quote marks and continues to read the line of code correctly but then places the "no sales price" correctly in the formula.
It will output the line as the formula is intended to be and the Chr(34) is like writing ""No Sales Price"" without the inevitable "expected end of statement" error
What I suggested will result in something like this:
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
Cells(LastRow + 1, 3).Formula = "=SUM(C1:C" & LastRow & ")"
Extra 1
Is it possible to use this formula to enter the word Total in the cell to the left?
Range("B" & LastRow + 1) = "Total"
Extra 2
One more just to push my luck, how about copying a formula all the way down a column the the last cell? =G2*57.5 copied until the last row in I
LastRowG = Cells(Rows.Count, "G").End(xlUp).Row
For i = 2 To LastRowG
Range("I" & i).Value = "=G" & i & "*57.5"
Next i