getting 2 different data tables to jive

[kenman]

Hi Everyone,

I have 2 databases on 1 worksheet.
One is 5 columns wide with 1 column being dates that exclude weekends, holidays, etc. and only has about 20 years of data.
The other is 12 columns wide and includes all dates from 1/1/1900 to 1/1/2020. It includes weekends, holidays
Is there an easy VBA code to write that will eliminate all the rows in the larger file whose dates don't include the dates in the smaller?
I have many files that I am trying to do this, and thought a VBA macro would be easiest.

I am trying a do loop

dim rowf as long
rowf = 2

do
if(cells(rowf,"N")<>cells(rowf,"B") then

*****How do I write a code in vba to delete just the cells in row rowf in just columns "A" through "L"?

end if

rowf=rowf+1
loop until cells(rowf,"N")=""

end sub

Any ideas? Is this the easiest or is there an easier way?

Thanks!!

Ken

 

[erik.van.geit]

Hi, Ken,
let's try out on a little sample first
if we can get this to work, enlarge the database will be easy

Map2.xls
	A	B	C	D
1	TABLE 1		TABLE 2
2	1		1	6
3	6		2	7
4	3		3	8
5	7		4	9
6	9		5	10
Blad1

what will you end up with ?
where will be the cells which are not deleted ?

kind regards,
Erik

 

[kenman]

2 databases

The first dbase is in columns A through L, the second dbase is in N through R. The date columns that I am trying to match up are in columns b and n.

When done, I want each row to contain all the information relevant to the dates in the N column.

ie. If the date in cell 2b doesn't equal the date in cell 2n, then I want to delete the cells in cells 2a through cells 2L. The dbase in cells A through L would move up a line. When the date in cell 2B equals the date in cell 2N, then the next query cell would cell 3N and the system would test for when cell 3B equals 3N. and on until the info in the left dbase is holding it's data for the same dates that the right dbase is holding.

Hopes that explains it.

Thanks for looking at it.

Ken

 

[erik.van.geit]

try this

Option Explicit

Sub clean_table()
'slow code
'Erik Van Geit
'051118
'search data from second column in table in MatchRange
'if not found delete line in table
'EXAMPLE
'BEFORE
'second column of table will be checked for match in column to the right
'a1  b1  c1  d1  e1  f1  g1  i1  j1  k1  l1          b5
'a2  b2  c2  d2  e2  f2  g2  i2  j2  k2  l2          b3
'a3  b3  c3  d3  e3  f3  g3  i3  j3  k3  l3
'a4  b4  c4  d4  e4  f4  g4  i4  j4  k4  l4
'a5  b5  c5  d5  e5  f5  g5  i5  j5  k1  l5
'AFTER
'a3  b3  c3  d3  e3  f3  g3  i3  j3  k3  l3
'a5  b5  c5  d5  e5  f5  g5  i5  j5  k1  l5

Dim MatchRange As Range
Dim LRC As Long
Dim LRM As Long
Dim I As Long

'do your edits here
Const FR = 2
Const CC = "B"  'column data to check (find match in MatchRange)
Const MC = "N"  'column MatchRange
Const FC = "A"  'first column table to clean up
Const LC = "L"  'last    "      "   "    "   "

LRC = Cells(Rows.Count, CC).End(xlUp).Row   'last row checkrange
LRM = Cells(Rows.Count, MC).End(xlUp).Row   'last row MatchRange

Set MatchRange = Range(MC & FR & ":" & MC & LRM)


Dim AppSetCalc As Integer
Dim AppSetEnEv As Integer
    With Application
    .ScreenUpdating = False
    AppSetCalc = .Calculation
    .Calculation = xlCalculationManual
    AppSetEnEv = .EnableEvents
    .EnableEvents = False
    End With
    
With MatchRange
    For I = LRC To FR Step -1
        If .Find(Cells(I, CC), LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
        Range(Cells(I, FC), Cells(I, LC)).Delete (xlUp)
        End If
    Application.StatusBar = "countdown: " & I - FR + 1
    Next I
End With

    With Application
    .ScreenUpdating = True
    .Calculation = AppSetCalc
    .EnableEvents = AppSetEnEv
    .StatusBar = False
    End With

End Sub

the example shows what it is doing
it is "slow" code, but I hope rather easy-to-understand
if you want to do this often there are better solutions
1. adding a column and just put "1" in columns which are OK, then sort and delete the empties (faster)
2. computing the arrays in memory (very fast)

kind regards,
Erik