- Joined
- Dec 21, 2010
- Messages
- 1
- Reaction score
- 0
I have a Sheet called AddBN. And In column C of this sheet, I have numbers that start with "978" and then I have other numbers that start with a range of other numbers.
I need help with making a Macro, so that all of the numbers in Column C that do NOT start with "978", need to be sent to another sheet, which is called "AddUPC".
The numbers that do NOT start with 978, that are being sent to the "AddUPC" sheet, also need its entire row to be pasted into that sheet as well.
I then need every Column to be shifted up so there are no spaces where ever their are missing numbers in Column C.
When I tried the Macro, below -- although it works -- it takes too long -- i.e., it does exactly what I need, but it continues to go through the entire column in the attempt to repetitively delete. This is too much time wasted going through the entire column; at 1,000,000 rows to go through, not very productive.
Sub moveit()
Dim x As Integer
Dim y As Integer
For x = 1 To Worksheets("AddBN" ).Range("C3" ).CurrentRegion.Rows.Count
If Left(Range("C" & x), 3) <> 978 Then
y = y + 1
Range("C" & x).EntireRow.Copy _
Destination:=Worksheets( "AddUPC").Range("A" & y)
Range("C" & x).EntireRow.Delete
x = x - 1
End If
Next x
End Sub
I need help with making a Macro, so that all of the numbers in Column C that do NOT start with "978", need to be sent to another sheet, which is called "AddUPC".
The numbers that do NOT start with 978, that are being sent to the "AddUPC" sheet, also need its entire row to be pasted into that sheet as well.
I then need every Column to be shifted up so there are no spaces where ever their are missing numbers in Column C.
When I tried the Macro, below -- although it works -- it takes too long -- i.e., it does exactly what I need, but it continues to go through the entire column in the attempt to repetitively delete. This is too much time wasted going through the entire column; at 1,000,000 rows to go through, not very productive.
Sub moveit()
Dim x As Integer
Dim y As Integer
For x = 1 To Worksheets("AddBN" ).Range("C3" ).CurrentRegion.Rows.Count
If Left(Range("C" & x), 3) <> 978 Then
y = y + 1
Range("C" & x).EntireRow.Copy _
Destination:=Worksheets( "AddUPC").Range("A" & y)
Range("C" & x).EntireRow.Delete
x = x - 1
End If
Next x
End Sub