Copying cell ranges instead row?

[Mike2502]

Hey All,

I'm trying to select the data from column A till P instead of copying, pasting and deleting the whole rows? please see code below and thanks in advance !

Sub Sort_Data()

    Cells.Select
    ActiveWorkbook.Worksheets("ADO").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ADO").Sort.SortFields.Add(Range("A1:A100"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 0 _
        , 0)
    ActiveWorkbook.Worksheets("ADO").Sort.SortFields.Add(Range("B1:B100"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 0 _
        , 0)
    With ActiveWorkbook.Worksheets("ADO").Sort
        .SetRange Range("A1:N100")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    With Sheets("ADO")
    If .AutoFilterMode Then .AutoFilterMode = False
    .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row).AutoFilter 1, RGB(255, 0, 0), xlFilterCellColor
    .AutoFilter.Range.Offset(1).EntireRow.Copy Sheets("TBD_Manually").Range("A" & Rows.Count).End(xlUp)(2)
    .AutoFilter.Range.Offset(1).EntireRow.Delete
    .ShowAllData
    .Range("A1:B" & .Range("B" & Rows.Count).End(xlUp).Row).AutoFilter 2, RGB(255, 0, 0), xlFilterCellColor
    .AutoFilter.Range.Offset(1).EntireRow.Copy Sheets("TBD_Manually").Range("A" & Rows.Count).End(xlUp)(2)
    .AutoFilter.Range.Offset(1).EntireRow.Delete
    .ShowAllData
  End With
 
   Range("A2").Select
  
End Sub

 

[Mike2502]

Are you saying that you have 50 rows of data with 50 vlookups, you delete 5 rows, you are left with 45 rows with data and the next 5 blank rows have no vlookups in them?

If yes then that is what should happen. If you want it to always have 50 vlookups after deleting then reapply the formula to the range in the VBA.

If it is anything else then please re-explain what is happening.

You're on the money mate,

Comes up with a syntax error below?

Range("H2").Formula = "=TEXT(IF(VLOOKUP($A2,DataSheet!$A$1:AB$700,25,FALSE)="""","""Currently Working""",VLOOKUP($A2,DataSheet!A$1:AB$700,25,FALSE)),"""dd mmmm yyyy""")"

 

[MARK858]

What is the formula as it appears in H2 in the spreadsheet?

 

[Mike2502]

What is the formula as it appears in H2 in the spreadsheet?

=TEXT(IF(VLOOKUP($A2,DataSheet!$A$1:AB$700,25,FALSE)="","Currently Working",VLOOKUP($A2,DataSheet!A$1:AB$700,25,FALSE)),"dd mmmm yyyy")

 

[MARK858]

Probably

Range("H2:H52").Formula = "=TEXT(IF(VLOOKUP($A2,DataSheet!$A$1:AB$700,25,FALSE)="""",""Currently Working"",VLOOKUP($A2,DataSheet!A$1:AB$700,25,FALSE)),""dd mmmm yyyy"")"

 

[Mike2502]

Probably

Range("H2:H52").Formula = "=TEXT(IF(VLOOKUP($A2,DataSheet!$A$1:AB$700,25,FALSE)="""",""Currently Working"",VLOOKUP($A2,DataSheet!A$1:AB$700,25,FALSE)),""dd mmmm yyyy"")"

Error mate;

Application-defined or object-defined error

Office VBA reference topic

docs.microsoft.com

 

[MARK858]

I run it and get no error

Sub DDHDH()
Range("H2:H52").Formula = "=TEXT(IF(VLOOKUP($A2,DataSheet!$A$1:AB$700,25,FALSE)="""",""Currently Working"",VLOOKUP($A2,DataSheet!A$1:AB$700,25,FALSE)),""dd mmmm yyyy"")"
End Sub

 

[Mike2502]

I run it and get no error

Sub DDHDH()
Range("H2:H52").Formula = "=TEXT(IF(VLOOKUP($A2,DataSheet!$A$1:AB$700,25,FALSE)="""",""Currently Working"",VLOOKUP($A2,DataSheet!A$1:AB$700,25,FALSE)),""dd mmmm yyyy"")"
End Sub

Beautiful mate, if I have any other errors am I okay to PM you?

 

[MARK858]

if I have any other errors am I okay to PM you?

You're welcome but no if you have any questions then ask them in a new thread or you run foul of rule 4 ...

Rule #4:

Members should not use the Private Message (Conversations) system to request specific assistance. All members are volunteers, contributing their time and expertise where and when they can, and such requests may be deemed harassment (see Rule #1).


Do not invite another member to take the question off the forum (i.e. do not suggest that they post to a different forum, do not suggest that they email or private message you the problem, do not simply post a link to another forum, unless it is to a specific, relevant, thread). This applies equally to members asking or answering questions.

 

[Mike2502]

You're welcome but no if you have any questions then ask them in a new thread or you run foul of rule 4 ...

Hi Mark,

The code you gave me stopped copying data to worksheet "TBD_Manually", really got me baffled .. Any idea?

Sub Sort_Data()
'
' Sort_Data Macro
' Sorts data by duplicates and leave reasons as Dismissals
'
Worksheets("ADO").Unprotect Password:="lol"

      With Sheets("ADO")
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Range("A1:P50" & .Range("A" & Rows.Count).End(xlUp).Row)
            .AutoFilter 1, RGB(255, 0, 0), xlFilterCellColor
            .Offset(1).Copy Sheets("TBD_Manually").Range("A" & Rows.Count).End(xlUp)(2)
            .Offset(1).Delete
            Sheets("ADO").ShowAllData
        End With
        With Sheets("ADO")
        With .Range("A1:P50" & .Range("B" & Rows.Count).End(xlUp).Row)
            .AutoFilter 2, RGB(255, 0, 0), xlFilterCellColor
            .Offset(1).Copy Sheets("TBD_Manually").Range("A2" & Rows.Count).End(xlUp)(2)
            .Offset(1).Delete
            Sheets("ADO").ShowAllData
        End With
    End With
    
    Worksheets("ADO").Protect Password:="lol"
    
End Sub

 

[MARK858]

To start with remove the extra With Sheets("ADO") that you have added (in red below). Then test again.

Sub Sort_Data()
'
' Sort_Data Macro
' Sorts data by duplicates and leave reasons as Dismissals
'
Worksheets("ADO").Unprotect Password:="lol"

      With Sheets("ADO")
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Range("A1:P50" & .Range("A" & Rows.Count).End(xlUp).Row)
            .AutoFilter 1, RGB(255, 0, 0), xlFilterCellColor
            .Offset(1).Copy Sheets("TBD_Manually").Range("A" & Rows.Count).End(xlUp)(2)
            .Offset(1).Delete
            Sheets("ADO").ShowAllData
        End With
        With Sheets("ADO")
        With .Range("A1:P50" & .Range("B" & Rows.Count).End(xlUp).Row)
            .AutoFilter 2, RGB(255, 0, 0), xlFilterCellColor
            .Offset(1).Copy Sheets("TBD_Manually").Range("A2" & Rows.Count).End(xlUp)(2)
            .Offset(1).Delete
            Sheets("ADO").ShowAllData
        End With
    End With
    
    Worksheets("ADO").Protect Password:="lol"
    
End Sub