I was searching for my problem .. but i couldn't find something good.
Im trying to copy some values from sheet 1 to sheet 2..
In sheet 1("xy") there are no hidden rows. In sheet 2("Adress") there are.
I would use a for-loop to do that:
end = cells(rows.count, 1).end(xlUp).row
Row = 1
For i = 11 To end
Sheets("xy").Select
Cells(Row, 19).Copy
Sheets("Adress").Select
Cells(i, 19).PasteSpecial xlPasteValues
Row = Row + 1
Next i
The problem is that the loop is still using the hidden rows in sheet2("Adress") ...
How can I skip them ?
Thanks for your help :)
The simplest way would be to paste it over separately using multiple paste commands as opposed to all at once as you could skip the hidden rows manually. The following code should work for doing it automatically:
end = cells(rows.count, 1).end(xlUp).row
Row = 1
For i = 11 To end
If Not Worksheet("Adress").Cells(i, 19).hidden Then
Worksheet("Adress").Cells(i, 19) = Worksheet("xy").Cells(Row, 19)
Row = Row + 1
End If
Next i
Related
Hi could someone enlighten me with some VBA code to insert formula =LEFT(H2,5) into column M and then stop at the last row of data.
The data it will be referencing will be inserted from the web so when i refresh the data pull the rows could be more or less so it can't be a fixed without using VB
Thanks
Rhys
You don't need a loop for this:
Sub qwerty()
Dim N As Long, r As Range
N = Cells(Rows.Count, "H").End(xlUp).Row
Set r = Range("M2:M" & N)
r.Formula = "=LEFT(H2,5)"
End Sub
You will find that the addresses in the formulas adjust just like in copy/paste.
Would a while loop work for you?
Dim i As Integer
i = 2 'starting row number
While Cells(i, 1).Value <> "" 'Empty row
Cells(i, 13).Formula = "=LEFT(H2,5)" 'replace this with something for that row, concatenating i to H will work i think.
i = i + 1
Wend
You'll also want to put this code to whenever the data is refreshed so it inserts the formula to all rows again.
Dim x As Long
x = Application.CountA(ActiveSheet.Columns(13))
ActiveSheet.Cells(2, 13) = "=LEFT(H2,5)"
ActiveSheet.Cells(2, 13).Resize(x - 1).Formula = ActiveSheet.Cells(2, 13).Formula
use excel function CountA to get the total number of row that you need to populate and assign that number to x
then put the actual formula on cells M2 then copy the formula until the last row using resize function
I am using a loop to find cells with a "0" entry in column B and then delete the entire corresponding rows.
Unfortunately, I am not able to write it so it only works for one specific worksheet. Here's what I got so far:
Dim myloop
For myloop = Range("B10000").End(xlUp).Row To 1 Step -1
If Cells(myloop, 4).Value = 0 Then Rows(myloop).EntireRow.Delete
Next myloop
I want this loop specifically to run only for worksheet 2 but not my entire code to run only in worksheet 2 as this loop is just part of a bigger code.
Any help is appreciated and thanks in advance.
You need to fully qualify your Range with a certian Worksheet.
Note: you could use the AutoFilter as well, works faster for large data.
With Worksheets("Sheet1") ' <-- modify "Sheet1" to your sheet's name
For myloop = .Range("B10000").End(xlUp).Row To 1 Step -1
If .Cells(myloop, 4).Value = 0 Then .Rows(myloop).EntireRow.Delete
Next myloop
End With
Alternative: to get the last row with data in Column B (if the data will be more than 10,000 rows)
With Worksheets("Sheet1") ' <-- modify "Sheet1" to your sheet's name
For myloop = .Range("B" & .Cells(.Rows.Count, "B")).End(xlUp).Row To 1 Step -1
If .Cells(myloop, 4).Value = 0 Then .Rows(myloop).EntireRow.Delete
Next myloop
End With
if the block of code is within a bigger loop looping through worksheets, Add a if condition (activesheet.index= 2) or just check if the activesheet is sheet2 or if its just a seperate loop then specify the sheet in the code
I run a report weekly and a step I must take is to delete a row that contains a certain phrase, in my case "CFS-GHOST-DJKT", in column A. Rows to read through start at 7 and have a variable end.
I have looked online and according to what I have found the following code should work but I get and error and it does not like the line With Cells(Lrow,"A")
I believe as far as the deleteing part goes it is ok the way it is written but the problem is the selection aspect.
Firstrow = 7
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
With Cells(Lrow, "A")
If Not IsError(.Value) Then
If .Value = "CFS-GHOST-DJKT" Then .EntireRow.Delete
End If
End With
You need to iterate from the last row to the first row when deleting else you will end up skipping rows.
Dim x As Long
For x = Cells(Rows.Count, "A").End(xlUp).Row To 7 Step -1
If Cells(x, "A") = "CFS-GHOST-DJKT" Then Rows(x).Delete
Next
as per you narrative ("I must ... delete a row") you seem to bother only one occurrence of the phrase "CFS-GHOST-DJKT"
in this case there's no need for iterating through cells but just try finding it and, if successful, delete its entire row
Dim f As Range
Set f = Range("A7", Cells(Rows.Count, "A").End(xlUp)).Find(what:="CFS-GHOST-DJKT", LookIn:=xlValues, lookat:=xlPart)
If Not f Is Nothing Then f.EntireRow.Delete
I'm writing a code that copies data from one sheet into another and I've got that function working fine. Now, I'm trying to code it to delete any rows that contain duplicate information based off that information's ID number in column F. Part of our process is to manually enter in column E when each row has been worked.
So my end goal is for the code to delete rows where column E is blank and column F is a duplicate. My code runs, but doesn't delete anything. I'm really hoping I'm just missing something ridiculously obvious.
For i = 1 To Range("f" & Rows.Count).End(xlUp).Row
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Not IsError(Application.Match(x, "F:F", 0)) Then '& if that row is a duplicate
ActiveSheet.Range(x).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
Try it with,
For i = Range("f" & Rows.Count).End(xlUp).Row to 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
Rows(i).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
You were trying to delete the row number x, not i. Additionally, everything was going to be matched once.
So there are a couple of errors that need to be addressed in your code. First, if you are looping over a range and deleting rows, it's best to start from the bottom and work your way up. This prevents issues where your iterator is on a row, that row gets deleted, and the loop essentially skips the next row.
Next, you are looking for a Match in column F of x, which contains a value from Column F. So, it will always return a value (itself, at the very minimum). Maybe try using a COUNTIF and seeing if it's greater than 1 may be a better option?
Next, you populated the variable x with the value in Cells(i, 6), but then you try to use it as a range when deleting. Change your code to the following and see if it works:
For i = Range("f" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
ActiveSheet.Rows(i).Delete 'delete new duplicate row
End If
End If
Next i
Why not use the .RemoveDuplicates method? It's faster than looping around. Here's a rough outline on its use:
With Range
.RemoveDuplicates Columns:=Array(6), Header:=xlYes
End With
Here's the msdn doc for the method, and another page with a more detailed implementation. They should clear up any questions you might have.
This question already has answers here:
Inserting rows above a specified rows
(2 answers)
Closed 7 years ago.
I using the below macro and it inserts the row below the cell with "Card Number"
I cannot get it to go above the row no matter what I do. Probably quite basic for some but have recently only found how useful macros are
Sub Insert()
Dim c As Range
For Each c In Range("A1:A5000")
If c.Value Like "*Card Number:*" Then
c.Offset(1, 0).EntireRow.Insert
End If
Next c
End Sub
As you probably tried you cannot just do c.EntireRow.Insert since it will insert a line above and it will keep in the For Each loop infinitely. The solution is to loop through the range in reverse, like done in this answer:
Sub InsertRev()
Dim c As Range
Set rng = ActiveSheet.Range("A1:A5000")
For dblCounter = rng.Cells.Count To 1 Step -1
Set c = rng(dblCounter)
If c.Value Like "*Card Number:*" Then
c.EntireRow.Insert
End If
Next dblCounter
End Sub
Don't use the Offset in that case, the Insert command always insert rows above the selection.
Further more, if you use for each, you don't have control on the direction in which your loop will be, so it is better to use for i = with step -1 to go from bottom to top.
Why? Because if you insert a new row from row i, the row i will become the row i+1 and you will test it on the next loop and keep adding rows!
Sub Insert_Rows()
Dim i As Long
For i = 5000 To 1 Step -1
If Cells(i, "A").Value Like "*Card Number:*" Then
Cells(i, "A").EntireRow.Insert
End If
Next i
End Sub
This is how I would solve this problem but I'm not that advanced in macros and I'm sure there is a better way.
Sub Insert()
For i = 1 To 5000
If Cells(i, "A") Like "*Card Number:*" Then ' loop trough 5000 cells in column A
Rows(i + 1).Insert 'insert bottom row first so it doesn't mess with row numbers
Rows(i - 1).Insert 'then you can insert upper row
i = i + 1 'jump over the next row as it now contains the card number for sure
End If
Next i
End Sub