Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Excel > Excel Programming

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 08-29-2017, 05:35 AM
Seiquo Seiquo is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Jun 2017
Posts: 4
Seiquo is on a distinguished road
Default Delete rows with certain values (plural)

Good morning forum,

What would be the VBA code to delete the rows that contain in column A one of the values listed in another spreadsheet, in column A too?



Workbook1, sheet1: 1200 rows, with a number in column A.

Workbook2, sheet1: 43 rows, with a number in column A. The numbers don't follow and are not in order (e.g. - in A2, A3, A4 : 45366, 43801, 43471, 46514...).

In workbook1, I need to delete the rows that contain in column A a number listed in Workbook2.

And cherry on top, the list in workbook2 may increase from month to month...

I know how to write the code to delete a row that contains a certain value, but I have no idea how to do it with a list of values.

Thank you so much in advance to anyone who can help me.
Reply With Quote
  #2  
Old 08-30-2017, 10:52 PM
serge1p serge1p is offline Windows 10 Office 2016
Novice
 
Join Date: Aug 2017
Posts: 3
serge1p is on a distinguished road
Default

Please consider the code below:

Code:
Private Function listNumbers(fileName As String, sheetName As String, columnName As String) As Long()
Dim result() As Long
Dim resultLength As Integer
Dim rangeName As String
Dim wb As Workbook
Dim rangeStartRow As Integer
Dim sh As Worksheet
Dim needToClose As Boolean
Dim i As Integer
    needToClose = True
    For i = 1 To Workbooks.Count
        If Workbooks(i).FullName = fileName Then
            needToClose = False
            Set wb = Workbooks(i)
        End If
    Next
    rangeStartRow = 1   ' change this as required
    If needToClose Then
        Set wb = Workbooks.Open(fileName, ReadOnly:=True)
    End If
    Set sh = wb.Worksheets(sheetName)
    resultLength = sh.Cells(sh.Rows.Count, columnName).End(xlUp).Row - rangeStartRow + 1
    ReDim result(resultLength - 1)
    
    For i = 1 To resultLength
        result(i - 1) = sh.Range(columnName & (rangeStartRow + i - 1)).Value
    Next
    listNumbers = result
    If needToClose Then
        wb.Close SaveChanges:=False
    End If
End Function

Public Sub DeleteRows()
Dim numbers() As Long
Dim pos As Variant
Dim cellNumber As Long
Dim cl As Range
    numbers = listNumbers("D:\aa\Book1.xlsx", "Sheet1", "A")
    For Each cl In ActiveSheet.Range("A:A").Cells
        If Not IsNumeric(cl.Value) Then
            Exit For
        End If
        cellNumber = cl.Value
        pos = Application.Match(cellNumber, numbers, False)
        If Not IsError(pos) Then
            '   mark the row for deletion
        End If
    Next
End Sub
I have not added any error handling or ScreenUpdating switching - and have not coded the actual deletion.
Let me know if you have any questions.
Reply With Quote
  #3  
Old 08-31-2017, 05:57 AM
Seiquo Seiquo is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Jun 2017
Posts: 4
Seiquo is on a distinguished road
Default

Good morning Serge1p,

First thank you very much for sparing some of your time to help me. Much appreciated.

I copied your code in the Workbook1 "ThisWorkBook" code sheet as follows:

Code:
Private Function listNumbers(fileName As String, sheetName As String, columnName As String) As Long()
Dim result() As Long
Dim resultLength As Integer
Dim rangeName As String
Dim wb As Workbook
Dim rangeStartRow As Integer
Dim sh As Worksheet
Dim needToClose As Boolean
Dim i As Integer
    needToClose = True
    For i = 1 To Workbooks.Count
        If Workbooks(i).FullName = fileName Then
            needToClose = False
            Set wb = Workbooks(i)
        End If
    Next
    rangeStartRow = 2   ' change this as required
    If needToClose Then
        Set wb = Workbooks.Open(fileName, ReadOnly:=True)
    End If
    Set sh = wb.Worksheets(sheetName)
    resultLength = sh.Cells(sh.Rows.Count, columnName).End(xlUp).Row - rangeStartRow + 1
    ReDim result(resultLength - 1)
 
    For i = 1 To resultLength
        result(i - 1) = sh.Range(columnName & (rangeStartRow + i - 1)).Value
    Next
    listNumbers = result
    If needToClose Then
        wb.Close SaveChanges:=False
    End If
End Function
Public Sub DeleteRows()
Dim numbers() As Long
Dim pos As Variant
Dim cellNumber As Long
Dim cl As Range
    numbers = listNumbers("C:\Users\chevalls\Desktop\MyFile.xlsx", "Sheet1", "A")
    For Each cl In ActiveSheet.Range("A:A").Cells
        If Not IsNumeric(cl.Value) Then
            Exit For
        End If
        cellNumber = cl.Value
        pos = Application.Match(cellNumber, numbers, False)
        If Not IsError(pos) Then
        cl.Interior.ColorIndex = 1
        End If
    Next
End Sub
I changed :
- the RangeStartRow number;
- the file path, assuming that the path refers to my Workbook1; and
- added the "whatif" at the end.

When I try to run the macro, I get the error message "400"...

Do you have any idea of what I did wrong?

Thank you again.
Reply With Quote
  #4  
Old 08-31-2017, 02:40 PM
serge1p serge1p is offline Windows 10 Office 2016
Novice
 
Join Date: Aug 2017
Posts: 3
serge1p is on a distinguished road
Default

Hello Seiquo,

A few points:
- the file path is for the second spreadsheet (with 43 numbers)
- not sure about which "whatif" you have added - is that the color change?
- when you get the error - do you know which exact line causes it?

try to step through the code by placing a breakpoint (click on any line and hit F9 function key) and then to move to the next line - F8 - or just use the menus - then it will be easier to identify the cause of your problem
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Get all rows based on input values from a list soolsen Excel 1 03-27-2016 08:11 PM
Looping through rows and copy cell values to another worksheet get4hari Excel Programming 1 10-02-2015 04:51 PM
Hide rows in multiple columns based on zero values Deane Excel Programming 19 06-23-2015 11:24 PM
Delete blank rows between the two rows that contain data beginner Excel Programming 5 12-26-2014 12:29 AM
Delete All empty Rows - Print - Undo all Rows deleted Bathroth Word VBA 1 10-01-2014 01:40 PM


All times are GMT -7. The time now is 03:35 PM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft