Creating IF statement

**anoctua** · 02-26-2014, 05:57 PM

Hi everyone

I am relatively new to VBA and am working on a piece of existing code after modifying an excel 2010 spreadsheet slightly. I have thrown this question out to Mr Excel however had not yet had an answer (and unfortunately I am working to a deadline at work with this sheet) and therefore I am hoping I may be able to locate an expert on this forum. http://www.mrexcel.com/forum/excel-q...statement.html If someone would be able to assist me, I would greatly appreciate it.

The macro I'm using is throwing up an error; this is the code:

'delete "old" claims
        Rows(OrigRow.Row).ClearContents
    End If
    Next
        CurrNewClaims.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'delete old claims and move to old claims tab
        CurrClaims.EntireRow.Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Old Claims").Select
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'add date to existing selection
        Selection.EntireRow.Columns("AJ").Value = Date
    
'Remove duplicated claims and update with recent data
    Set CurrNewClaims = ActiveSheet.Range("e1", ActiveSheet.Range("e65536").End(xlUp))
    For iX = CurrNewClaims.Rows.Count To 2 Step -1
    If WorksheetFunction.CountIf(CurrNewClaims, Cells(iX, 5).Value) > 1 Then
    Set OrigRow = CurrNewClaims.Find(Cells(iX, 5).Value, LookIn:=xlValues, lookat:=xlWhole)
        Rows(OrigRow.Row).ClearContents
    End If
    Next
    
    'delete all blank rows
    Set NewClaims = ActiveSheet.Range("a2", ActiveSheet.Range("a65536").End(xlUp))
    FirstRow = NewClaims.Row
    LastRow = NewClaims(NewClaims.Count).Row
    On Error Resume Next
    NewClaims.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    'Selection.EntireRow.ClearContents
        
'sort by DWC at closure and move back to "current claims" tab
    ActiveWorkbook.Worksheets("Old Claims").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Old Claims").AutoFilter.Sort.SortFields.Add Key:= _
        Range("H1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Old Claims").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        Sheets("Current Claims").Activate
     
'delete all blank rows from "current claims" tab
    Set CurrClaims = ActiveSheet.Range("e1", ActiveSheet.Range("e65536").End(xlUp))
        Selection.ClearContents
        CurrClaims.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        Range("AG2:AG5000").ClearContents
'sort remaining claims in ascending order by current DWC
        Cells.Select
        ActiveWorkbook.Worksheets("Current Claims").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Current Claims").Sort.SortFields.Add Key:=Range( _
        "H2:H844"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Current Claims").Sort
        .SetRange Range("A1:AI844")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'come back to current claims tab
    Sheets("Current Claims").Activate
    
'turn screen updating on
Application.ScreenUpdating = True
    End Sub

Occassionally there will be instances where there is no data to select (no rows at all - because any blanks have been deleted and there are no additional rows of data) and the macro throws up an object error at the CurrClaims.EntireRow.Select (line 7)

'delete old claims and move to old claims tab
        CurrClaims.EntireRow.Select

It was suggested to me that I put IF statements in the code to say if there is nothing in that range then do this (after delete old claims):

 'delete "old" claims
        Rows(OrigRow.Row).ClearContents
    End If
    Next
        CurrNewClaims.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'delete all blank rows from "current claims" tab
    Set CurrClaims = ActiveSheet.Range("e1", ActiveSheet.Range("e65536").End(xlUp))
        Selection.ClearContents
        CurrClaims.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        Range("AG2:AG5000").ClearContents

'sort remaining claims in ascending order by current DWC
        Cells.Select
        ActiveWorkbook.Worksheets("Current Claims").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Current Claims").Sort.SortFields.Add Key:=Range( _
        "H2:H844"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Current Claims").Sort
        .SetRange Range("A1:AI844")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
       
'turn screen updating on
Application.ScreenUpdating = True
    End Sub

But IF there are claims then:

 'delete "old" claims
        Rows(OrigRow.Row).ClearContents
    End If
    Next
        CurrNewClaims.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'delete old claims and move to old claims tab
        CurrClaims.EntireRow.Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Old Claims").Select
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'add date to existing selection
        Selection.EntireRow.Columns("AJ").Value = Date
    
'Remove duplicated claims and update with recent data
    Set CurrNewClaims = ActiveSheet.Range("e1", ActiveSheet.Range("e65536").End(xlUp))
    For iX = CurrNewClaims.Rows.Count To 2 Step -1
    If WorksheetFunction.CountIf(CurrNewClaims, Cells(iX, 5).Value) > 1 Then
    Set OrigRow = CurrNewClaims.Find(Cells(iX, 5).Value, LookIn:=xlValues, lookat:=xlWhole)
        Rows(OrigRow.Row).ClearContents
    End If
    Next
    
    'delete all blank rows
    Set NewClaims = ActiveSheet.Range("a2", ActiveSheet.Range("a65536").End(xlUp))
    FirstRow = NewClaims.Row
    LastRow = NewClaims(NewClaims.Count).Row
    On Error Resume Next
    NewClaims.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    'Selection.EntireRow.ClearContents
        
'sort by DWC at closure and move back to "current claims" tab
    ActiveWorkbook.Worksheets("Old Claims").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Old Claims").AutoFilter.Sort.SortFields.Add Key:= _
        Range("H1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Old Claims").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        Sheets("Current Claims").Activate
     
'delete all blank rows from "current claims" tab
    Set CurrClaims = ActiveSheet.Range("e1", ActiveSheet.Range("e65536").End(xlUp))
        Selection.ClearContents
        CurrClaims.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        Range("AG2:AG5000").ClearContents
'sort remaining claims in ascending order by current DWC
        Cells.Select
        ActiveWorkbook.Worksheets("Current Claims").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Current Claims").Sort.SortFields.Add Key:=Range( _
        "H2:H844"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Current Claims").Sort
        .SetRange Range("A1:AI844")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'come back to current claims tab
    Sheets("Current Claims").Activate
    
'turn screen updating on
Application.ScreenUpdating = True
    End Sub

Would someone please be able to assist me with the code to make this happen? I am not experienced enough to work this out. I have tried various things and it seems to ignore what I am putting in there.

Thanks very much