View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
Oldjay Oldjay is offline
external usenet poster
 
Posts: 337
Default Transfering records based on a condition

I tried to send you the whole work book but it failed (Security?) with the
following message

Norman - I have enclosed a copy of my file. Please note that I have not
assigned any code to the Command buttons yet.
I changed Cols B and C so that there was always data in the B col just in
case thats was the problem. I also changed the sheet names to Checkbook and
Checkbook Summary.

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("Bank Balance Worksheet .xls")

With WB
Set SH = .Sheets("Checkbook")
Set destSH = .Sheets("Checkbook Summary")
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("A20: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


"Norman Jones" wrote:

Hi OldJay,

Perhaps you would care to send me a sample of
problematic data.

norman_jones@NOSPAMbtconnectDOTcom

(Delete "NOSPAM" and replace "DOT" with a full stop [period] )



---
Regards,
Norman



"Oldjay" wrote in message
...
I think my problem is that the B col is sometimes blank
The C col alway has an entry
oldjay

"Norman Jones" wrote:

Hi OldJay,

The code works for me without problem: it copies
columns B:E of all rows on Sheet1, from row 20
onward, which have a column a value of X, to the
foot of a list in the sheet 'Verified' which starts at
cell B9.

---
Regards,
Norman
Microsoft Excel MVP


"Oldjay" wrote in message
...
Code is Removing Records with "X" but is not inserting then into
destSheet

"Norman Jones" wrote:

Hi OldJay,

Please change:

Set rng = .Range("A1:A" & LRow)

with

Set rng = .Range("A20:A" & LRow)


---
Regards,
Norman