Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfering records based on a condition
I have a list of records. I want to move all of the records (cols B thru E)
to sheet "Verified "if the value in the A col is a "X" . The Records will be added to the bottom of the existing list in Sheet "Verified" oldjay |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfering records based on a condition
Hi OldJay,
Try something like: '============ Public Sub CopyRange() Dim WB As Workbook Dim SH As Worksheet Dim destSH As Worksheet Dim destRng As Range Dim rng As Range Dim copyRng As Range Dim rCell As Range Dim LRow As Long Dim CalcMode As Long Const sStr = "X" Set WB = Workbooks("MyBook.xls") '<<==== CHANGE With WB Set SH = .Sheets("Sheet1") Set destSH = .Sheets("Verified") End With Set destRng = destSH.Cells(Rows.Count, "A").End(xlUp)(2) LRow = Cells(Rows.Count, "A").End(xlUp).Row Set rng = SH.Range("A1:A" & LRow) On Error GoTo XIT With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With For Each rCell In rng.Cells If InStr(1, rCell, sStr, vbTextCompare) 0 Then If copyRng Is Nothing Then Set copyRng = rCell.Offset(0, 1).Resize(1, 4) Else Set copyRng = _ Union(rCell.Offset(0, 1).Resize(1, 4), copyRng) End If End If Next rCell If Not copyRng Is Nothing Then copyRng.Copy Destination:=destRng End If XIT: With Application .Calculation = CalcMode .ScreenUpdating = True End With End Sub '<<============ --- Regards, Norman "Oldjay" wrote in message ... I have a list of records. I want to move all of the records (cols B thru E) to sheet "Verified "if the value in the A col is a "X" . The Records will be added to the bottom of the existing list in Sheet "Verified" oldjay |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfering records based on a condition
"Norman Jones" wrote: Hi OldJay, Try something like: '============ Public Sub CopyRange() Dim WB As Workbook Dim SH As Worksheet Dim destSH As Worksheet Dim destRng As Range Dim rng As Range Dim copyRng As Range Dim rCell As Range Dim LRow As Long Dim CalcMode As Long Const sStr = "X" Set WB = Workbooks("MyBook.xls") '<<==== CHANGE With WB Set SH = .Sheets("Sheet1") Set destSH = .Sheets("Verified") End With Set destRng = destSH.Cells(Rows.Count, "A").End(xlUp)(2) LRow = Cells(Rows.Count, "A").End(xlUp).Row Set rng = SH.Range("A1:A" & LRow) On Error GoTo XIT With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With For Each rCell In rng.Cells If InStr(1, rCell, sStr, vbTextCompare) 0 Then If copyRng Is Nothing Then Set copyRng = rCell.Offset(0, 1).Resize(1, 4) Else Set copyRng = _ Union(rCell.Offset(0, 1).Resize(1, 4), copyRng) End If End If Next rCell If Not copyRng Is Nothing Then copyRng.Copy Destination:=destRng End If XIT: With Application .Calculation = CalcMode .ScreenUpdating = True End With End Sub '<<============ --- Regards, Norman "Oldjay" wrote in message ... I have a list of records. I want to move all of the records (cols B thru E) to sheet "Verified "if the value in the A col is a "X" . The Records will be added to the bottom of the existing list in Sheet "Verified" oldjay |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfering records based on a condition
I didn't tell you every thing
The list in Sheet 1 starts at row B20 The list on sheet Verify starts B9 I want to move them not copy to the bottom of the existing list "Oldjay" wrote: "Norman Jones" wrote: Hi OldJay, Try something like: '============ Public Sub CopyRange() Dim WB As Workbook Dim SH As Worksheet Dim destSH As Worksheet Dim destRng As Range Dim rng As Range Dim copyRng As Range Dim rCell As Range Dim LRow As Long Dim CalcMode As Long Const sStr = "X" Set WB = Workbooks("MyBook.xls") '<<==== CHANGE With WB Set SH = .Sheets("Sheet1") Set destSH = .Sheets("Verified") End With Set destRng = destSH.Cells(Rows.Count, "A").End(xlUp)(2) LRow = Cells(Rows.Count, "A").End(xlUp).Row Set rng = SH.Range("A1:A" & LRow) On Error GoTo XIT With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With For Each rCell In rng.Cells If InStr(1, rCell, sStr, vbTextCompare) 0 Then If copyRng Is Nothing Then Set copyRng = rCell.Offset(0, 1).Resize(1, 4) Else Set copyRng = _ Union(rCell.Offset(0, 1).Resize(1, 4), copyRng) End If End If Next rCell If Not copyRng Is Nothing Then copyRng.Copy Destination:=destRng End If XIT: With Application .Calculation = CalcMode .ScreenUpdating = True End With End Sub '<<============ --- Regards, Norman "Oldjay" wrote in message ... I have a list of records. I want to move all of the records (cols B thru E) to sheet "Verified "if the value in the A col is a "X" . The Records will be added to the bottom of the existing list in Sheet "Verified" oldjay |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfering records based on a condition
Hi OldJay,
'-------------------- I didn't tell you every thing The list in Sheet 1 starts at row B20 The list on sheet Verify starts B9 I want to move them not copy to the bottom of the existing list '-------------------- Try the following version: '============ Public Sub CopyRange() Dim WB As Workbook Dim SH As Worksheet Dim destSH As Worksheet Dim destRng As Range Dim rng As Range Dim copyRng As Range Dim rCell As Range Dim LRow As Long Dim iRow As Long Dim CalcMode As Long Const sStr = "X" Set WB = Workbooks("MyBook.xls") '<<==== CHANGE With WB Set SH = .Sheets("Sheet1") Set destSH = .Sheets("Verified") End With With destSH iRow = .Range("B" & .Rows.Count).End(xlUp).Row If iRow < 9 Then iRow = 8 End If Set destRng = .Range("B" & iRow + 1) End With With SH LRow = .Cells(Rows.Count, "A").End(xlUp).Row Set rng = .Range("A1:A" & LRow) End With On Error GoTo XIT With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With For Each rCell In rng.Cells If InStr(1, rCell, sStr, vbTextCompare) 0 Then If copyRng Is Nothing Then Set copyRng = rCell.Offset(0, 1).Resize(1, 4) Else Set copyRng = _ Union(rCell.Offset(0, 1).Resize(1, 4), copyRng) End If End If Next rCell If Not copyRng Is Nothing Then With copyRng .Copy Destination:=destRng .EntireRow.Delete End With End If XIT: With Application .Calculation = CalcMode .ScreenUpdating = True End With End Sub '<<============ --- Regards, Norman |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfering records based on a condition
Hi OldJay,
Please change: Set rng = .Range("A1:A" & LRow) with Set rng = .Range("A20:A" & LRow) --- Regards, Norman |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Sum If based on a 3rd condition ? | Excel Worksheet Functions | |||
How to select certains records meeting a certain condition !!!! | Excel Worksheet Functions | |||
How to select certains records meeting a certain condition !!!! | Excel Worksheet Functions | |||
What formula/fn would I use to count multiple condition records? | Excel Worksheet Functions | |||
transfering info from one sheet to another based on info being transferred | Excel Programming |