Trouble with Excel Range syntax using variables

[nodrog77]

Note: Excel 2003

Hi There (again),

I'm currently tearing my hair out trying to define ranges using variables rather than hard coding in the references

Dim TheCell As Range
Dim TheNextCellDown As Range
Dim ANCol As String
Dim StartofDataRow As Long
Dim i As Long

' These Values will probably change
StartofDataRow = 3
ANCol = "B"

With ActiveWorkbook.Sheets("All Data")

TheCell = Range(ANCol & (StartofDataRow + i)) 'eg "B3"
TheNextCellDown = Range(ANCol & (StartofDataRow + i + 1)) 'eg B4

Do Until IsEmpty(TheCell.Value)
If TheCell.Value = TheNextCellDown.Value Then
' Process the duplicate

etc...

I am aware that this is all do-able by selecting a cell, making is active then going and using the offset method but I am trying to rewrite this bit of code to be firstly more readable/debuggable and secondly faster if possible.

Please Tell me this is possible somehow.

Lea.

 

[Kostarsus]

Hi,

there is a simpler way to declare an range, than to use the range with characters.

Try this:

    Dim sheet As Worksheet
    Dim cell As Range
    
    Set sheet = ActiveSheet
    Set cell = sheet.Cells(1, 1)
    
    cell.Value = "1"

I hope this will help you.

cu Kostarsus

 

[GlennUK]

Replace this:

TheCell = Range(ANCol & (StartofDataRow + i)) 'eg "B3"
   TheNextCellDown = Range(ANCol & (StartofDataRow + i + 1)) 'eg B4

with this:

Set TheCell = Range(ANCol & (StartofDataRow + i)) 'eg "B3"
Set TheNextCellDown = TheCell.OffSet(1) 'eg B4

Cheers, Glenn.

Beauty is in the eye of the beerholder.

 

[SkipVought]

hmmmmm....

What are your doing in "Process the duplicate?"


Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[nodrog77]

Thanks Glenn,
- I knew it was something simple!!!

I will now cease tearing my hair out and proceed to dye it blonde.

Skip - > the process the duplicate will involve moving the row with the duplicate AN (ANCol is the primary key) to another spreadsheet. Nothing fancy, but if I can get this right I can convince my boss to let me rewrite a lot of unreadable, slow code that we have hanging about, this is a snippet of the original loop

'--------------------------------------------------------- OLD LOOP
Do Until IsEmpty(ActiveCell)
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
If NumberOfDups = 2 Then ' if there are no duplicates yet
Sheets.Add.Name = "Duplicates" ' This makes Duplicates the active sheet

' copy headers
ActiveWorkbook.Sheets("All Data").Rows("1:2").Copy _
Destination:=Sheets("Duplicates").Rows("1:2")
ActiveWorkbook.Sheets("All Data").Select
End If

ActiveCell.EntireRow.Copy _
Destination:=Sheets("Duplicates").Range("A" + CStr(NumberOfDups + 2))
NumberOfDups = NumberOfDups + 1
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
'--------------------------------------------------------- OLD LOOP

Maybe will post when it's complete - but It's Saturday Morning here now so I'll seeya.

Thanks again.

Lea

 

[nodrog77]

Final Code:
Note I used "Range(ANKey)(StartofDataRow + i)" syntax at the start to walk down the column -> I'm working out what I prefer then I'll be consistent, this is a work in progress - but this is a basic snippet
Dim i As Long
Dim ANCol As String
Dim StartofDataRow As Long

Dim TheCell As Range
Dim TheNextCellDown As Range

Application.ScreenUpdating = False
Application.StatusBar = "extracting duplicates please wait..."

'Set SMG, AN and Date References by The Stage
StartofDataRow = 3
ANCol = "B"
ANKey = ANCol & (StartofDataRow)
SMGKey = "D3"

...... 'then

With ActiveWorkbook.Sheets("All Data")

Set TheCell = Range(ANKey)(StartofDataRow + i) 'eg B3
Set TheNextCellDown = TheCell.Offset(1) 'eg B4


Do Until IsEmpty(TheCell.Value)


If TheCell.Value = TheNextCellDown.Value Then

' If this is the first Set of Duplicates, add the WorkSheet
If NumberOfDups = 0 Then
ActiveWorkbook.Sheets.Add.Name = "Duplicates" ' Note This makes Duplicates the active sheet

' copy headers 'LG15OCT2010 - Removed select ->copy header macro - MAYBE DEFINE A HEADER ROW RANGE, hard coding = BAD
ActiveWorkbook.Sheets("All Data").Rows("1:2").Copy _
Destination:=Sheets("Duplicates").Rows("1:2")
ActiveWorkbook.Sheets("All Data").Select
End If

' Only the First Duplicate Row is removed, which should be the one with the earlier sale date
' Set DestinationRange = Sheets("Duplicates").Range(ANCol & (NumberOfDups + 2))
TheCell.EntireRow.Copy _
Destination:=Sheets("Duplicates").Rows(NumberOfDups + 2)
TheCell.EntireRow.Delete
' Reset the Cell Value
Set TheCell = Range(ANKey)(StartofDataRow + i) 'eg B3
Set TheNextCellDown = TheCell.Offset(1) 'eg B4

NumberOfDups = NumberOfDups + 1

Else ' Go to the next Cell down
i = i + 1
Set TheCell = Range(ANKey)(StartofDataRow + i) 'eg B3
Set TheNextCellDown = TheCell.Offset(1) 'eg B4

End If

Loop 'Is an empty cell

End With

Again, thanks for the help, Lea

 

[firefytr]

If you're going to use the With statement, you might as well qualify your range. And there is no need to Select anything. I would also recommend checking if the sheet was created before creating it. Here is an example with your partial code...

Sub TekTipsTest()

    Dim i As Long
    Dim ANCol As String
    Dim StartofDataRow As Long
    Dim TheCell As Range
    Dim TheNextCellDown As Range
    
    'added variables
    Dim ANKey As String, SMGKey As String, NumberOfDups As Long
    
    Application.ScreenUpdating = False
    Application.StatusBar = "extracting duplicates please wait..."
    
    'Set SMG, AN and Date References by The Stage
    StartofDataRow = 3
    ANCol = "B"
    ANKey = "B3" ' ANCol & (StartofDataRow)
    SMGKey = "D3"

'...... 'then
    
    With ActiveWorkbook.Sheets("All Data")
    
        Set TheCell = .Range(ANKey).Offset(StartofDataRow + i) 'eg B3
        Set TheNextCellDown = TheCell.Offset(1) 'eg B4
        
     
        Do Until IsEmpty(TheCell.Value)
        

            If TheCell.Value = TheNextCellDown.Value Then
            
                ' If this is the first Set of Duplicates, add the WorkSheet
                If NumberOfDups = 0 Then
                    If WSEXISTS("Duplicates") = False Then
                        ActiveWorkbook.Sheets.Add.Name = "Duplicates" ' Note This makes Duplicates the active sheet
                    End If
                    ' copy headers 'LG15OCT2010 - Removed select ->copy header macro - MAYBE DEFINE A HEADER ROW RANGE, hard coding = BAD
                    ActiveWorkbook.Sheets("All Data").Rows("1:2").Copy _
                                                        Destination:=.Parent.Sheets("Duplicates").Rows("1:2")
'                    ActiveWorkbook.Sheets("All Data").Select
                End If
                
                ' Only the First Duplicate Row is removed, which should be the one with the earlier sale date
                ' Set DestinationRange = Sheets("Duplicates").Range(ANCol & (NumberOfDups + 2))
                TheCell.EntireRow.Copy _
                        Destination:=.Parent.Sheets("Duplicates").Rows(NumberOfDups + 2)
                TheCell.EntireRow.Delete
                ' Reset the Cell Value
                Set TheCell = .Range(ANKey).Offset(StartofDataRow + i) 'eg B3
                Set TheNextCellDown = TheCell.Offset(1) 'eg B4

                NumberOfDups = NumberOfDups + 1
                
            Else ' Go to the next Cell down
                i = i + 1
                Set TheCell = .Range(ANKey).Offset(StartofDataRow + i) 'eg B3
                Set TheNextCellDown = TheCell.Offset(1) 'eg B4

            End If
            
        Loop 'Is an empty cell
        
    End With

End Sub

Function WSEXISTS(wsName As String, Optional wb As Workbook)
    If ActiveWorkbook Is Nothing Then Exit Function
    If wb Is Nothing Then Set wb = ActiveWorkbook
    On Error Resume Next
    WSEXISTS = Len(wb.Sheets(wsName).Name)
End Function

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP?
- Leonardo da Vinci

 

[nodrog77]

Thanks ZAC - it does need a some more tweaking - 12:30 am Saturday Morning is not always the best time to be coding.

Lea.