Using ActiveCell to specify a column

[DavidW]

In the code below I am stepping through all the cells on the workshee
"Master" and moving certain rows to a worksheet "Complete". Only th
rows that have a value in the H column called "Comp Date" will be move
to the other sheet. How would I specify the column in my If statemen
below? This line is incorrect - If sourceRange.Column(Comp Date). Tha
should give you an idea of what I need.


Code
-------------------
Dim Bcell As Range
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
' I omitted some code that works
For Each Bcell In Worksheets("Master").Range("A2", LastCell)
Set sourceRange = ActiveCell.EntireRow
' the following line is wrong - it needs to refer to column H /Comp Date
If sourceRange.Column(Comp Date) <> "" Then 'this line is wrong
Set destrange = Sheets("Complete").Rows(Lr + 1)
sourceRange.Copy destrange
sourceRange.EntireRow.Delete
End If
Next Bcel

 

[Ron de Bruin]

Try this David

If Cells(Bcell.Row, "H").Value <> "" Then

 

[Bob Phillips]

Is CompDate a string containing say H

If sourceRange.Cells(1,CompDate).Value <> ""

or a range containg the column H,

If sourceRange.Cells(1,Comp Date.Column).Value <> ""


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[DavidW]

In my code above, I should probably have my If statement before settin
the source range. It should probably be something like this:


Code
-------------------
Dim Bcell As Range
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
' I omitted some code that works
For Each Bcell In Worksheets("Master").Range("A2", LastCell)
' the following line is wrong - it needs to refer to column H /Comp Date
If Active.Column(Comp Date) <> "" Then 'this line is wrong
Set sourceRange = ActiveCell.EntireRow
Set destrange = Sheets("Complete").Rows(Lr + 1)
sourceRange.Copy destrange
sourceRange.EntireRow.Delete
End If
Next Bcel

 

[DavidW]

Thanks, Ron and Bob.

Comp Date is the column name for column H in the spreadsheet.

I was able to specify the column with Ron's suggestion:

Code
-------------------
If Cells(Bcell.Row, "H").Value <> "
-------------------


However, my code is not actually doing what I intended (my fault). I'l
need to rethink my logic. I need to step through each row and then chec
column H for values before moving the row to another sheet. The way m
code is written, it is stepping through every cell.

The For statement should be something like this:


Code
-------------------
For Each *Row* In Worksheets("Master").Range("A2", LastCell
-------------------


LastCell holds the address of the last cell in the last row tha
contains values. I'll have to figure out how to step through each row
select it or make it active, and then do the If statement and th
remaining code

 

[Ron de Bruin]

Why not use AutoFilter with code to do it
Try this on a copy of your workbook

Note : I use WS.Range("A1").CurrentRegion
If your data is not one block with empty rows and columns use a fixed range like WS.Range("A1:H1000")

You can check the current region by selecting A1 and press Ctrl-*
If it not select all your data use WS.Range("A1:H1000")

Another option is to use my EasyFilter add-in
http://www.rondebruin.nl/easyfilter.htm


Sub Copy_With_AutoFilter1()
Dim WS As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim Str As String

Set WS = Sheets("Master") '<<< Change
'A1 is the top left cell of your filter range and the header of the first column
Set rng = WS.Range("A1").CurrentRegion '<<< Change
Str = "<>" '<<< Change

'Close AutoFilter first
WS.AutoFilterMode = False

'This example filter on the first column in the range (change the field if needed)
rng.AutoFilter Field:=8, Criteria1:=Str

Set WSNew = Worksheets.Add

WS.AutoFilter.Range.Copy
With WSNew.Range("A1")
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With

' 'If you want to delete the rows in WS that you copy use this also
With WS.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then rng2.EntireRow.Delete
End With

WS.AutoFilterMode = False

On Error Resume Next
WSNew.Name = "Complete"
If Err.Number > 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
End Sub