Consulting

Results 1 to 2 of 2

Thread: Solved: Delete specific cells not entire row

  1. #1
    VBAX Contributor
    Joined
    Dec 2006
    Posts
    193
    Location

    Solved: Delete specific cells not entire row

    The last part of thecode below checks for duplictes in collum H and if any are foundwill delete the entire row.I wish to alter the code so that cells in collum H:K and V:AB are deleted not the entire row. so for example say cell H10 was a duplict cells H10:K10 and celss V10:AB10 would be deleted.
    THANKS

    [VBA]
    Sub Button3_Click()
    a = MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", _
    vbYesNo)

    If a = vbYes Then
    Cancel = True
    Dim WsTgt As Excel.Worksheet
    Dim rngCopy As Excel.Range
    Application.ScreenUpdating = False
    Workbooks.Open Filename:= _
    "L:\Documents and Settings\NPC.xls", UpdateLinks:=3
    Windows("NPB.xls").Activate
    Set WsTgt = Workbooks("NPC.xls").Sheets("GD")
    With WsTgt.Range("h" & NextEmptyRow(WsTgt))


    ActiveSheet.Range("C8:c35").Copy
    .Offset(, 0).PasteSpecial xlPasteValues
    ActiveSheet.Range("E8:G35").Copy
    .Offset(, 1).PasteSpecial xlPasteValues
    ActiveSheet.Range("J8:J35").Copy
    .Offset(, 14).PasteSpecial xlPasteValues
    ActiveSheet.Range("M8:M35").Copy
    .Offset(, 15).PasteSpecial xlPasteValues
    ActiveSheet.Range("O8:O35").Copy
    .Offset(, 16).PasteSpecial xlPasteValues
    ActiveSheet.Range("P8:P35").Copy
    .Offset(, 17).PasteSpecial xlPasteValues
    ActiveSheet.Range("Q8:Q35").Copy
    .Offset(, 18).PasteSpecial xlPasteValues
    ActiveSheet.Range("R8:R35").Copy
    .Offset(, 19).PasteSpecial xlPasteValues
    ActiveSheet.Range("I8:I35").Copy
    .Offset(, 20).PasteSpecial xlPasteValues
    Windows("NPC.xls").Activate


    Dim wSheet As Worksheet
    Dim x As Long
    Dim LastRow As Long
    Application.ScreenUpdating = False
    Sheets(1).Select
    For Each wSheet In Worksheets
    wSheet.Select
    LastRow = Range("h" & Rows.Count).End(xlUp).Row
    For x = LastRow To 1 Step -1
    If Application.WorksheetFunction.CountIf(Range("h1:h" & x), Range("h" & x).Value) > 1 Then
    Range("h" & x).EntireRow.Delete
    End If
    Next x
    Next wSheet


    Application.ScreenUpdating = True
    End With
    End If
    End Sub
    [/VBA]

  2. #2
    VBAX Regular
    Joined
    Nov 2008
    Posts
    44
    Location
    If you find a duplicate, you could use this to delete the cell range and move the cells below it up.

    [vba]Range("H" & x & ":K" & x).Delete Shift:=xlUp
    Range("V" & x & ":AB" & x).Delete Shift:=xlUp[/vba]
    Where x is the row number.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •