ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Looping through a Range and copying to Another Sheet (https://www.excelbanter.com/excel-programming/376386-looping-through-range-copying-another-sheet.html)

Big H

Looping through a Range and copying to Another Sheet
 
Hi there,

I am new to VBA, and I am wondering if its possible to do the following:

I have a range of data (dynamic), which shouldn't go any more than 200 rows,
and is within columns A:H. What i want to do is loop through the range and
anything which has "CCLS" within column H, then copy it to sheet CCLS.
Sometimes there might not be "CCLS" within column H, so some sort of error
code may need to be added to make the code work.

tia Harry



Ron de Bruin

Looping through a Range and copying to Another Sheet
 

Hi Big H

Try this
http://www.rondebruin.nl/copy5.htm

--
Regards Ron de Bruin
http://www.rondebruin.nl



"Big H" wrote in message ...
Hi there,

I am new to VBA, and I am wondering if its possible to do the following:

I have a range of data (dynamic), which shouldn't go any more than 200 rows, and is within columns A:H. What i want to do is loop
through the range and anything which has "CCLS" within column H, then copy it to sheet CCLS. Sometimes there might not be "CCLS"
within column H, so some sort of error code may need to be added to make the code work.

tia Harry




bobbo

Looping through a Range and copying to Another Sheet
 
I think this should work

Sub CpyCCLS()
dim rg1 as range
dim cpyrg as range
dim dest as range
dim i as integer



for i = 1 to 200
set rg1 = Activesheet.Range("H" & i)
if rg1.value = "CCLS" then
set cpyrg = Activesheet.Range("A" & i & ":H" & i)
set dest = Worksheets("CCLS").Range("A65536").End(xlup).offse t(1,0)
cpyrg.copy
dest.pastespecial
end if
next

end sub


Big H wrote:
Hi there,

I am new to VBA, and I am wondering if its possible to do the following:

I have a range of data (dynamic), which shouldn't go any more than 200 rows,
and is within columns A:H. What i want to do is loop through the range and
anything which has "CCLS" within column H, then copy it to sheet CCLS.
Sometimes there might not be "CCLS" within column H, so some sort of error
code may need to be added to make the code work.

tia Harry



Big H

Looping through a Range and copying to Another Sheet
 
Bobbo,
thanks this is perfect, however would it be possible to copy the row if
columnA = "P" and clomnH = "CCLS"

thanks for your help

Harry

"bobbo" wrote in message
oups.com...
I think this should work

Sub CpyCCLS()
dim rg1 as range
dim cpyrg as range
dim dest as range
dim i as integer



for i = 1 to 200
set rg1 = Activesheet.Range("H" & i)
if rg1.value = "CCLS" then
set cpyrg = Activesheet.Range("A" & i & ":H" & i)
set dest = Worksheets("CCLS").Range("A65536").End(xlup).offse t(1,0)
cpyrg.copy
dest.pastespecial
end if
next

end sub


Big H wrote:
Hi there,

I am new to VBA, and I am wondering if its possible to do the following:

I have a range of data (dynamic), which shouldn't go any more than 200
rows,
and is within columns A:H. What i want to do is loop through the range
and
anything which has "CCLS" within column H, then copy it to sheet CCLS.
Sometimes there might not be "CCLS" within column H, so some sort of
error
code may need to be added to make the code work.

tia Harry





bobbo

Looping through a Range and copying to Another Sheet
 
Replace this line of code

if rg1.value = "CCLS" then

with this

if rg1.value = "CCLS" and range("A" & rg1.row).value = "P" then

I think that should do the trick.

Big H wrote:
Bobbo,
thanks this is perfect, however would it be possible to copy the row if
columnA = "P" and clomnH = "CCLS"

thanks for your help

Harry

"bobbo" wrote in message
oups.com...
I think this should work

Sub CpyCCLS()
dim rg1 as range
dim cpyrg as range
dim dest as range
dim i as integer



for i = 1 to 200
set rg1 = Activesheet.Range("H" & i)
if rg1.value = "CCLS" then
set cpyrg = Activesheet.Range("A" & i & ":H" & i)
set dest = Worksheets("CCLS").Range("A65536").End(xlup).offse t(1,0)
cpyrg.copy
dest.pastespecial
end if
next

end sub


Big H wrote:
Hi there,

I am new to VBA, and I am wondering if its possible to do the following:

I have a range of data (dynamic), which shouldn't go any more than 200
rows,
and is within columns A:H. What i want to do is loop through the range
and
anything which has "CCLS" within column H, then copy it to sheet CCLS.
Sometimes there might not be "CCLS" within column H, so some sort of
error
code may need to be added to make the code work.

tia Harry




Big H

Looping through a Range and copying to Another Sheet
 
Ron,
thanks for this, a previous post you sent on deleting rows was excellent
however I modified it slightly to suit my needs. The only problem I have is
when a row shows #N/A it does not get deleted. My code is below, any help
you can give me is appreciated.

Sub DeleteRows()
Dim Firstrow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
LastRow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1

With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "I").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

ElseIf .Cells(Lrow, "I").Value = "CSVS" Then .Rows(Lrow).Delete
'This will delete each row with the Value "CSVS" in Column
I, case sensitive.

End If
Next
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "I").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

ElseIf .Cells(Lrow, "I").Value = "CMPN" Then .Rows(Lrow).Delete
'This will delete each row with the Value "CMPN" in Column
I, case sensitive.

End If
Next
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "I").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

ElseIf .Cells(Lrow, "I").Value = "RMAT" Then .Rows(Lrow).Delete
'This will delete each row with the Value "CMPN" in Column
I, case sensitive.

End If
Next
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "I").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

ElseIf .Cells(Lrow, "I").Value = "#N/A" Then .Rows(Lrow).Delete
'This will delete each row with the Value "#N/A" in Column
I, case sensitive.

End If
Next
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "I").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

ElseIf .Cells(Lrow, "I").Value = "EXTN" Then .Rows(Lrow).Delete
'This will delete each row with the Value "EXTN" in Column
I, case sensitive.

End If
Next
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "I").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

ElseIf .Cells(Lrow, "I").Value = "EXRP" Then .Rows(Lrow).Delete
'This will delete each row with the Value "EXRP" in Column
A, case sensitive.

End If
Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End With
End With
End With
End With
End With
End Sub


thanks Harry


"Ron de Bruin" wrote in message
...

Hi Big H

Try this
http://www.rondebruin.nl/copy5.htm

--
Regards Ron de Bruin
http://www.rondebruin.nl



"Big H" wrote in message
...
Hi there,

I am new to VBA, and I am wondering if its possible to do the following:

I have a range of data (dynamic), which shouldn't go any more than 200
rows, and is within columns A:H. What i want to do is loop through the
range and anything which has "CCLS" within column H, then copy it to
sheet CCLS. Sometimes there might not be "CCLS" within column H, so some
sort of error code may need to be added to make the code work.

tia Harry






Ron de Bruin

Looping through a Range and copying to Another Sheet
 
If you want to delete all error cells then use

For Lrow = Lastrow To Firstrow Step -1
If IsError(.Cells(Lrow, "I").Value) Then
.Rows(Lrow).Delete
ElseIf .Cells(Lrow, "I").Value = "CSVS" Then .Rows(Lrow).Delete
End If
Next


--
Regards Ron de Bruin
http://www.rondebruin.nl



"Big H" wrote in message ...
Ron,
thanks for this, a previous post you sent on deleting rows was excellent however I modified it slightly to suit my needs. The only
problem I have is when a row shows #N/A it does not get deleted. My code is below, any help you can give me is appreciated.

Sub DeleteRows()
Dim Firstrow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
LastRow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1

With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "I").Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, "I").Value = "CSVS" Then .Rows(Lrow).Delete
'This will delete each row with the Value "CSVS" in Column I, case sensitive.

End If
Next
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "I").Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, "I").Value = "CMPN" Then .Rows(Lrow).Delete
'This will delete each row with the Value "CMPN" in Column I, case sensitive.

End If
Next
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "I").Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, "I").Value = "RMAT" Then .Rows(Lrow).Delete
'This will delete each row with the Value "CMPN" in Column I, case sensitive.

End If
Next
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "I").Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, "I").Value = "#N/A" Then .Rows(Lrow).Delete
'This will delete each row with the Value "#N/A" in Column I, case sensitive.

End If
Next
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "I").Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, "I").Value = "EXTN" Then .Rows(Lrow).Delete
'This will delete each row with the Value "EXTN" in Column I, case sensitive.

End If
Next
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "I").Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, "I").Value = "EXRP" Then .Rows(Lrow).Delete
'This will delete each row with the Value "EXRP" in Column A, case sensitive.

End If
Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End With
End With
End With
End With
End With
End Sub


thanks Harry


"Ron de Bruin" wrote in message ...

Hi Big H

Try this
http://www.rondebruin.nl/copy5.htm

--
Regards Ron de Bruin
http://www.rondebruin.nl



"Big H" wrote in message ...
Hi there,

I am new to VBA, and I am wondering if its possible to do the following:

I have a range of data (dynamic), which shouldn't go any more than 200 rows, and is within columns A:H. What i want to do is
loop through the range and anything which has "CCLS" within column H, then copy it to sheet CCLS. Sometimes there might not be
"CCLS" within column H, so some sort of error code may need to be added to make the code work.

tia Harry









All times are GMT +1. The time now is 12:43 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com