CODEWITHSUNDEEP
vbaexcel
user1996971
user1996971

Reputation: 543

II have six lists in Excel, and I want to match them based on the first item of each, using VBA

So I have a worksheet with 6 list of data, each with 6 columns of data. In each of the six datasets, I just want to pull out those that have a matching set number. For example,

LIST 1        LIST 2         LIST 3         LIST 4         LIST 5         LIST 6
001 ------    003 ------     002 ------     003 ------     003 ------     003 ------
002 ------    004 ------     003 ------     006 ------     004 ------     005 ------
003 ------    005 ------     006 ------     007 ------     009 ------     013 ------

These are six list of data. Only the first column (001, 004, etc) in each set is of interest in this sorting macro. Here, each list shares the line "003-----". I want to write a macro that will delete any lines that don't match with the others. Is there a macro that could sort through this, and leave me with only 003-----?

I've been writing a looping macro that's saying "if Rng (A1) > Rng.Offset(,6) AND Rng > Rng.Offset(,12)... Then (delete the relevant lines)

However, for this, I'll need to cover every possibility available. Is there another more obvious approach I'm missing?

Screenshot of some data (click the pic to enlarge)

enter image description here

It's the numbers beginning with "BC..." that I want to match, while retaining the four columns that come with each

Upvotes: 0

Views: 84

Answers (1)

Makah
Makah

Reputation: 4513

Here is the code. Sorry about O(n^4) complexity, but it works. Whatching your printscreen I saw that you need to Step Column 6, so i put that const to help you.

Const STEP_COLUMN As Integer = 6

Sub foo()
    Dim lastRow As Integer, lastColumn As Integer
    Dim rowIndex As Integer, columnIndex As Integer
    Dim ok As Boolean, value As Double

    lastRow = Range("A10000").End(xlUp).Row
    lastColumn = Range("XX1").End(xlToLeft).Column
    For columnIndex = 1 To lastColumn Step STEP_COLUMN
        For rowIndex = 1 To lastRow

        value = Cells(rowIndex, columnIndex)
        Call deleteIfNotExistInEveryColumn(value, lastRow, lastColumn)

        Next rowIndex
    Next columnIndex
End Sub

Sub deleteIfNotExistInEveryColumn(value, lastRow, lastColumn)
    Dim rowIndex As Integer, columnIndex As Integer

    For columnIndex = 1 To lastColumn Step STEP_COLUMN
        hasValue = False
        For rowIndex = 1 To lastRow
            If value = Cells(rowIndex, columnIndex) Then
                hasValue = True
            End If
        Next rowIndex

        If Not hasValue Then
            ActiveSheet.Cells.Replace What:=value, Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        End If
    Next columnIndex
End Sub

PS: I could use Match and delete every number that is not in the first column [because if the value is not in the first column then the value is not in every column :-)], but I prefered to build the complete code without optimizations

Upvotes: 2

Related Questions