Macro Help - Move/Delete based on cell criteria

cmschmitz24 · Aug 12, 2021

Hello, I have quite a big ask for help on a macro I'm building (or wanting to build).
I have attached the current spreadsheet after my current macro has been ran, named UW_COBRA_QUERY_example. PS I have removed some sensitive data and replaced it with "DATA".

UW_COBRA_QUERY_example.xlsx

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

AE

AF

AG

AH

AI

AJ

AK

AL

AM

AN

AO

AP

AQ

AR

AS

AT

AU

AV

AW

AX

AY

AZ

BA

BB

BC

BD

BE

BF

BG

BH

BI

BJ

BK

BL

BM

BN

BO

BP

BQ

BR

BS

BT

BU

BV

BW

BX

BY

BZ

CA

CB

CC

CD

CE

CF

CG

CH

CI

CJ

CK

CL

CM

CN

CO

CP

CQ

CR

CS

CT

CU

CV

CW

CX

CY

CZ

DA

DB

DC

DD

DE

DF

DG

DH

DI

DJ

DK

DL

DM

DN

DO

DP

DQ

DR

DS

1

Ticket #

Completed Date

2

COB.EMPLID

COB_EMPL_RCD

COB.PLAN_TYPE

COB.EVENT_DT

COB.DEPENDENT_ID

COB.RELATIONSHIP

First Name

Middle

Last

COB.EMPL_NAME

COB.APPLICANT_NAME

COB.ADDRESS1

COB.ADDRESS2

COB.CITY

COB.STATE

COB.POSTAL

Country

Descr

COB.PHONE

COB.BIRTHDATE

COB.SEX

COB.MAR_STATUS

COB.NATIONAL_ID

COB.MEMBER_ID

COB.UW_MEMBER_ID

COB.BENEFIT_PLAN

COB.ENROLL_CD

COB.UW_BN_ENROLL_RSN

Combined Reason

Reason

COB.COVRG_CD

COB.EFFDT

COB.COVERAGE_LVL

COB.COVERAGE_ELECT_DT

COB.COVERAGE_END_DT

COB.TERMINATION_DT

COB.TERMINATION_REASON

COB.NOTIFIED_DT

COB.NOTICEDATE

COB.BUSINESS_UNIT

COB.INSTITUTION_NAME

COB.ANNUAL_PLEDGE

COB.FSA_BALANCE

COB.RATE

COB.PROCESSED

PLAN.XLAT

PLAN.DESCR

PLAN.GROUP

COVRG.DESCR

PROMPT_EMPLID

1 DEP.DEPENDENT_BENEF

1 DEP.NAME

1 DEP.BIRTHDATE

1 DEP.SEX

1 DEP.RELATIONSHIP

1 DEP.DISABLED

1 DEP.UW_TAX_DEPENDENT

1 DEP.MAR_STATUS

2 DEP.DEPENDENT_BENEF

2 DEP.NAME

2 DEP.BIRTHDATE

2 DEP.SEX

2 DEP.RELATIONSHIP

2 DEP.DISABLED

2 DEP.UW_TAX_DEPENDENT

2 DEP.MAR_STATUS

3 DEP.DEPENDENT_BENEF

3 DEP.NAME

3 DEP.BIRTHDATE

3 DEP.SEX

3 DEP.RELATIONSHIP

3 DEP.DISABLED

3 DEP.UW_TAX_DEPENDENT

3 DEP.MAR_STATUS

4 DEP.DEPENDENT_BENEF

4 DEP.NAME

4 DEP.BIRTHDATE

4 DEP.SEX

4 DEP.RELATIONSHIP

4 DEP.DISABLED

4 DEP.UW_TAX_DEPENDENT

4 DEP.MAR_STATUS

5 DEP.DEPENDENT_BENEF

5 DEP.NAME

5 DEP.BIRTHDATE

5 DEP.SEX

5 DEP.RELATIONSHIP

5 DEP.DISABLED

5 DEP.UW_TAX_DEPENDENT

5 DEP.MAR_STATUS

6 DEP.DEPENDENT_BENEF

6 DEP.NAME

6 DEP.BIRTHDATE

6 DEP.SEX

6 DEP.RELATIONSHIP

6 DEP.DISABLED

6 DEP.UW_TAX_DEPENDENT

6 DEP.MAR_STATUS

7 DEP.DEPENDENT_BENEF

7 DEP.NAME

7 DEP.BIRTHDATE

7 DEP.SEX

7 DEP.RELATIONSHIP

7 DEP.DISABLED

7 DEP.UW_TAX_DEPENDENT

7 DEP.MAR_STATUS

8 DEP.DEPENDENT_BENEF

8 DEP.NAME

8 DEP.BIRTHDATE

8 DEP.SEX

8 DEP.RELATIONSHIP

8 DEP.DISABLED

8 DEP.UW_TAX_DEPENDENT

8 DEP.MAR_STATUS

ADD Fields

ADD Number Months

ADD Premium

ADD Other

12/31/2020

Plan Coverage Begin

DltDntTER

DelDntRET

DltDntEND

3

00826012

0

10

6/1/2018

00

E

DATA

8/4/1982

F

M

DATA

DEAN

14

G

14G

Term

1

1/7/2017

7/1/2018

6/30/2018

006

6/16/2018

7/1/2018

DATA

0.00

453.680000

Y

State Group Health

Dean w/Dental

1

Single

00826012

4

00826012

0

10

5/1/2021

00

E

DATA

8/4/1982

F

M

DATA

DEAN

14

G

14G

Term

15

3/1/2021

3/17/2021

5/31/2021

6/30/2020

006

6/12/2020

5/1/2021

DATA

0.00

1248.660000

Y

State Group Health

Dean & Dental

1

Family

00826012

01

DATA

7/22/1977

M

Spouse

N

Y

M

5

00826012

0

10

5/1/2021

00

E

DATA

8/4/1982

F

M

DATA

DEAN

14

G

14G

Term

15

3/1/2021

3/17/2021

5/31/2021

6/30/2020

006

6/12/2020

5/1/2021

DATA

0.00

1248.660000

Y

State Group Health

Dean & Dental

1

Family

00826012

02

DATA

5/18/2019

M

Child

N

S

6

00826012

0

10

5/1/2021

00

E

DATA

8/4/1982

F

M

DATA

DEAN

14

G

14G

Term

15

3/1/2021

3/17/2021

5/31/2021

6/30/2020

006

6/12/2020

5/1/2021

DATA

0.00

1248.660000

Y

State Group Health

Dean & Dental

1

Family

00826012

03

DATA

3/23/2021

M

Child

N

S

7

00826012

0

10

6/1/2021

00

E

DATA

USA

United States

DATA

8/4/1982

F

M

DATA

DEAN

14

G

14G

Term

15

3/1/2021

6/23/2021

6/30/2021

6/22/2021

001

6/1/2021

6/23/2021

DATA

0.00

1248.660000

Y

State Group Health

Dean & Dental

1

Family

00826012

01

DATA

7/22/1977

M

Spouse

N

Y

M

8

00826012

0

10

6/1/2021

00

E

DATA

USA

United States

DATA

8/4/1982

F

M

DATA

DEAN

14

G

14G

Term

15

3/1/2021

6/23/2021

6/30/2021

6/22/2021

001

6/1/2021

6/23/2021

DATA

0.00

1248.660000

Y

State Group Health

Dean & Dental

1

Family

00826012

02

DATA

5/18/2019

M

Child

N

S

9

00826012

0

10

6/1/2021

00

E

DATA

USA

United States

DATA

8/4/1982

F

M

DATA

DEAN

14

G

14G

Term

15

3/1/2021

6/23/2021

6/30/2021

6/22/2021

001

6/1/2021

6/23/2021

DATA

0.00

1248.660000

Y

State Group Health

Dean & Dental

1

Family

00826012

03

DATA

3/23/2021

M

Child

N

S

10

00826012

0

14

6/1/2018

00

E

DATA

8/4/1982

F

M

DATA

VSP

14

G

14G

Term

1

1/7/2017

7/1/2018

6/30/2018

006

6/16/2018

7/1/2018

DATA

0.00

6.540000

Y

Vision Insurance

VSP Vision Insurance

1

Single

00826012

11

00826012

0

14

5/1/2021

00

E

DATA

8/4/1982

F

M

DATA

DLTVSN

14

G

14G

Term

16

12/1/2020

3/17/2021

5/31/2021

6/30/2020

006

6/12/2020

5/1/2021

DATA

0.00

11.420000

Y

Vision Insurance

DeltaVision

1

Employee & Spouse

00826012

01

DATA

7/22/1977

M

Spouse

N

Y

M

12

00826012

0

14

6/1/2021

00

E

DATA

USA

United States

DATA

8/4/1982

F

M

DATA

DLTVSN

14

G

14G

Term

16

12/1/2020

6/23/2021

6/30/2021

6/22/2021

001

6/1/2021

6/23/2021

DATA

0.00

11.420000

Y

Vision Insurance

DeltaVision

1

Employee & Spouse

00826012

01

DATA

7/22/1977

M

Spouse

N

Y

M

COBRA

Cell Formulas
Range	Formula
AC3:AC12	AC3	=CONCATENATE(AA3,AB3)
AD3:AD12	AD3	=VLOOKUP(AC3,'Reason Translator'!A:B,2,FALSE)
DK3:DK12	DK3	=LEFT(Z3,3)
DL3:DL12	DL3	=DATEDIF(AI3,$DO$2,"M")
DM3:DM12	DM3	=VLOOKUP(Z3,'Reason Translator'!F:G,2,FALSE)*DL3
DN3:DN12	DN3	=VLOOKUP(Z3,'Reason Translator'!F:G,2,FALSE)
DO3:DO12	DO3	=AI3+60
DP3:DP12	DP3	=AI3+1
DQ3:DQ12	DQ3	=IF(AD3="Term",AJ3,"")
DR3:DR12	DR3	=IF(AD3="Retirement",AJ3,"")
DS3:DS12	DS3	=IF(AD3="Divorce",EDATE(D3,36),EDATE(D3,18))

1. I need to have any rows deleted if they are outside the appropriate date frame, listed in column AI. Can you help with a code that will delete rows if the date in this column is 90 days outside of today's date? Both 90 days prior to today's date and 90 days after today's date.

2. After the rows have been deleted based on date frame, I will need to have any dependents moved to their respective dependent rows/columns. Dependent data is located in columns AY-BF to start. The data will need to be moved based on column C. Therefore, if column C has a "10" only move dependents that are listed with that number in column C. Each dependent has it's own number listed in column AY. That number should match up with the headers for each dependent column. So, dependent 01 would go to columns AY-BF, dependent 02 would go to columns BG-BN, and so on through dependent 08. I assume this would be an if then statement formula with moving cells appropriately. After the dependent information has been moved, that row can be deleted. Not all will have dependents listed to be moved.
If there is a duplicate (same number in column C and same dependent number in column AY), like the one in the example for "14" in column C, the most recent date in column AI should stay.

I have attached a final version of what the spreadsheet should look like after the above, named UW_COBRA_QUERY_example_finished.

UW_COBRA_QUERY_example_finished.xlsx

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

AE

AF

AG

AH

AI

AJ

AK

AL

AM

AN

AO

AP

AQ

AR

AS

AT

AU

AV

AW

AX

AY

AZ

BA

BB

BC

BD

BE

BF

BG

BH

BI

BJ

BK

BL

BM

BN

BO

BP

BQ

BR

BS

BT

BU

BV

BW

BX

BY

BZ

CA

CB

CC

CD

CE

CF

CG

CH

CI

CJ

CK

CL

CM

CN

CO

CP

CQ

CR

CS

CT

CU

CV

CW

CX

CY

CZ

DA

DB

DC

DD

DE

DF

DG

DH

DI

DJ

DK

DL

DM

DN

DO

DP

DQ

DR

DS

1

Ticket #

Completed Date

2

COB.EMPLID

COB_EMPL_RCD

COB.PLAN_TYPE

COB.EVENT_DT

COB.DEPENDENT_ID

COB.RELATIONSHIP

First Name

Middle

Last

COB.EMPL_NAME

COB.APPLICANT_NAME

COB.ADDRESS1

COB.ADDRESS2

COB.CITY

COB.STATE

COB.POSTAL

Country

Descr

COB.PHONE

COB.BIRTHDATE

COB.SEX

COB.MAR_STATUS

COB.NATIONAL_ID

COB.MEMBER_ID

COB.UW_MEMBER_ID

COB.BENEFIT_PLAN

COB.ENROLL_CD

COB.UW_BN_ENROLL_RSN

Combined Reason

Reason

COB.COVRG_CD

COB.EFFDT

COB.COVERAGE_LVL

COB.COVERAGE_ELECT_DT

COB.COVERAGE_END_DT

COB.TERMINATION_DT

COB.TERMINATION_REASON

COB.NOTIFIED_DT

COB.NOTICEDATE

COB.BUSINESS_UNIT

COB.INSTITUTION_NAME

COB.ANNUAL_PLEDGE

COB.FSA_BALANCE

COB.RATE

COB.PROCESSED

PLAN.XLAT

PLAN.DESCR

PLAN.GROUP

COVRG.DESCR

PROMPT_EMPLID

1 DEP.DEPENDENT_BENEF

1 DEP.NAME

1 DEP.BIRTHDATE

1 DEP.SEX

1 DEP.RELATIONSHIP

1 DEP.DISABLED

1 DEP.UW_TAX_DEPENDENT

1 DEP.MAR_STATUS

2 DEP.DEPENDENT_BENEF

2 DEP.NAME

2 DEP.BIRTHDATE

2 DEP.SEX

2 DEP.RELATIONSHIP

2 DEP.DISABLED

2 DEP.UW_TAX_DEPENDENT

2 DEP.MAR_STATUS

3 DEP.DEPENDENT_BENEF

3 DEP.NAME

3 DEP.BIRTHDATE

3 DEP.SEX

3 DEP.RELATIONSHIP

3 DEP.DISABLED

3 DEP.UW_TAX_DEPENDENT

3 DEP.MAR_STATUS

4 DEP.DEPENDENT_BENEF

4 DEP.NAME

4 DEP.BIRTHDATE

4 DEP.SEX

4 DEP.RELATIONSHIP

4 DEP.DISABLED

4 DEP.UW_TAX_DEPENDENT

4 DEP.MAR_STATUS

5 DEP.DEPENDENT_BENEF

5 DEP.NAME

5 DEP.BIRTHDATE

5 DEP.SEX

5 DEP.RELATIONSHIP

5 DEP.DISABLED

5 DEP.UW_TAX_DEPENDENT

5 DEP.MAR_STATUS

6 DEP.DEPENDENT_BENEF

6 DEP.NAME

6 DEP.BIRTHDATE

6 DEP.SEX

6 DEP.RELATIONSHIP

6 DEP.DISABLED

6 DEP.UW_TAX_DEPENDENT

6 DEP.MAR_STATUS

7 DEP.DEPENDENT_BENEF

7 DEP.NAME

7 DEP.BIRTHDATE

7 DEP.SEX

7 DEP.RELATIONSHIP

7 DEP.DISABLED

7 DEP.UW_TAX_DEPENDENT

7 DEP.MAR_STATUS

8 DEP.DEPENDENT_BENEF

8 DEP.NAME

8 DEP.BIRTHDATE

8 DEP.SEX

8 DEP.RELATIONSHIP

8 DEP.DISABLED

8 DEP.UW_TAX_DEPENDENT

8 DEP.MAR_STATUS

ADD Fields

ADD Number Months

ADD Premium

ADD Other

12/31/2020

Plan Coverage Begin

DltDntTER

DelDntRET

DltDntEND

3

00826012

0

10

6/1/2021

00

E

DATA

USA

United States

DATA

8/4/1982

F

M

DATA

DEAN

14

G

14G

Term

15

3/1/2021

6/23/2021

6/30/2021

6/22/2021

001

6/1/2021

6/23/2021

DATA

0.00

1248.660000

Y

State Group Health

Dean & Dental

1

Family

00826012

01

DATA

7/22/1977

M

Spouse

N

Y

M

02

DATA

5/18/2019

M

Child

N

S

03

DATA

3/23/2021

M

Child

N

S

4

00826012

0

14

6/1/2021

00

E

DATA

USA

United States

DATA

8/4/1982

F

M

DATA

DLTVSN

14

G

14G

Term

16

12/1/2020

6/23/2021

6/30/2021

6/22/2021

001

6/1/2021

6/23/2021

DATA

0.00

11.420000

Y

Vision Insurance

DeltaVision

1

Employee & Spouse

00826012

01

DATA

7/22/1977

M

Spouse

N

Y

M

COBRA

Cell Formulas
Range	Formula
AC3:AC4	AC3	=CONCATENATE(AA3,AB3)
AD3:AD4	AD3	=VLOOKUP(AC3,'Reason Translator'!A:B,2,FALSE)
DK3:DK4	DK3	=LEFT(Z3,3)
DL3:DL4	DL3	=DATEDIF(AI3,$DO$2,"M")
DM3:DM4	DM3	=VLOOKUP(Z3,'Reason Translator'!F:G,2,FALSE)*DL3
DN3:DN4	DN3	=VLOOKUP(Z3,'Reason Translator'!F:G,2,FALSE)
DO3:DO4	DO3	=AI3+60
DP3:DP4	DP3	=AI3+1
DQ3:DQ4	DQ3	=IF(AD3="Term",AJ3,"")
DR3:DR4	DR3	=IF(AD3="Retirement",AJ3,"")
DS3:DS4	DS3	=IF(AD3="Divorce",EDATE(D3,36),EDATE(D3,18))

Here's my current macro.

VBA Code:

Sub COBRAMacro()
'
' COBRAMacro Macro
'

'
    'names first tab
    Sheets("sheet1").Select
    Sheets("sheet1").Name = "COBRA"
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Reason Translator"
    
    Sheets("COBRA").Select
    
    Range("A1").Value = "Ticket #"
    Range("A1").Copy
    Range("C1").PasteSpecial
    Range("C1").Value = "Completed Date"
    Range("B1").ClearContents
    
    Columns("AZ:BD").Select
    Selection.Cut
    Columns("AR:AR").Select
    Selection.Insert Shift:=xlToRight
    Range("AW2:BD2").Select
    Selection.Copy
    Range("BE2").Select
    ActiveSheet.Paste
    Range("BM2").Select
    ActiveSheet.Paste
    Range("BU2").Select
    ActiveSheet.Paste
    Range("CC2").Select
    ActiveSheet.Paste
    Range("CK2").Select
    ActiveSheet.Paste
    Range("CS2").Select
    ActiveSheet.Paste
    Range("DA2").Select
    ActiveSheet.Paste
    
    'adds dependent headers
    Range("AW2").Value = "1 DEP.DEPENDENT_BENEF"
    Range("AX2").Value = "1 DEP.NAME"
    Range("AY2").Value = "1 DEP.BIRTHDATE"
    Range("AZ2").Value = "1 DEP.SEX"
    Range("BA2").Value = "1 DEP.RELATIONSHIP"
    Range("BB2").Value = "1 DEP.DISABLED"
    Range("BC2").Value = "1 DEP.UW_TAX_DEPENDENT"
    Range("BD2").Value = "1 DEP.MAR_STATUS"
    Range("BE2").Value = "2 DEP.DEPENDENT_BENEF"
    Range("BF2").Value = "2 DEP.NAME"
    Range("BG2").Value = "2 DEP.BIRTHDATE"
    Range("BH2").Value = "2 DEP.SEX"
    Range("BI2").Value = "2 DEP.RELATIONSHIP"
    Range("BJ2").Value = "2 DEP.DISABLED"
    Range("BK2").Value = "2 DEP.UW_TAX_DEPENDENT"
    Range("BL2").Value = "2 DEP.MAR_STATUS"
    Range("BM2").Value = "3 DEP.DEPENDENT_BENEF"
    Range("BN2").Value = "3 DEP.NAME"
    Range("BO2").Value = "3 DEP.BIRTHDATE"
    Range("BP2").Value = "3 DEP.SEX"
    Range("BQ2").Value = "3 DEP.RELATIONSHIP"
    Range("BR2").Value = "3 DEP.DISABLED"
    Range("BS2").Value = "3 DEP.UW_TAX_DEPENDENT"
    Range("BT2").Value = "3 DEP.MAR_STATUS"
    Range("BU2").Value = "4 DEP.DEPENDENT_BENEF"
    Range("BV2").Value = "4 DEP.NAME"
    Range("BW2").Value = "4 DEP.BIRTHDATE"
    Range("BX2").Value = "4 DEP.SEX"
    Range("BY2").Value = "4 DEP.RELATIONSHIP"
    Range("BZ2").Value = "4 DEP.DISABLED"
    Range("CA2").Value = "4 DEP.UW_TAX_DEPENDENT"
    Range("CB2").Value = "4 DEP.MAR_STATUS"
    Range("CC2").Value = "5 DEP.DEPENDENT_BENEF"
    Range("CD2").Value = "5 DEP.NAME"
    Range("CE2").Value = "5 DEP.BIRTHDATE"
    Range("CF2").Value = "5 DEP.SEX"
    Range("CG2").Value = "5 DEP.RELATIONSHIP"
    Range("CH2").Value = "5 DEP.DISABLED"
    Range("CI2").Value = "5 DEP.UW_TAX_DEPENDENT"
    Range("CJ2").Value = "5 DEP.MAR_STATUS"
    Range("CK2").Value = "6 DEP.DEPENDENT_BENEF"
    Range("CL2").Value = "6 DEP.NAME"
    Range("CM2").Value = "6 DEP.BIRTHDATE"
    Range("CN2").Value = "6 DEP.SEX"
    Range("CO2").Value = "6 DEP.RELATIONSHIP"
    Range("CP2").Value = "6 DEP.DISABLED"
    Range("CQ2").Value = "6 DEP.UW_TAX_DEPENDENT"
    Range("CR2").Value = "6 DEP.MAR_STATUS"
    Range("CS2").Value = "7 DEP.DEPENDENT_BENEF"
    Range("CT2").Value = "7 DEP.NAME"
    Range("CU2").Value = "7 DEP.BIRTHDATE"
    Range("CV2").Value = "7 DEP.SEX"
    Range("CW2").Value = "7 DEP.RELATIONSHIP"
    Range("CX2").Value = "7 DEP.DISABLED"
    Range("CY2").Value = "7 DEP.UW_TAX_DEPENDENT"
    Range("CZ2").Value = "7 DEP.MAR_STATUS"
    Range("DA2").Value = "8 DEP.DEPENDENT_BENEF"
    Range("DB2").Value = "8 DEP.NAME"
    Range("DC2").Value = "8 DEP.BIRTHDATE"
    Range("DD2").Value = "8 DEP.SEX"
    Range("DE2").Value = "8 DEP.RELATIONSHIP"
    Range("DF2").Value = "8 DEP.DISABLED"
    Range("DG2").Value = "8 DEP.UW_TAX_DEPENDENT"
    Range("DH2").Value = "8 DEP.MAR_STATUS"
    
    'highlights dependent headers
    Range("AW2:BD2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 48
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("BE2:BL2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 48
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("BM2:BT2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 48
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("BU2:CB2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 48
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("CC2:CJ2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 48
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Range("CK2:CR2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 48
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("CS2:CZ2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 48
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("DA2:DH2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 48
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    
    
       
    'adds termination combined reason and Reason Translator tab
    Sheets("Reason Translator").Select
    
    Range("A1").Value = "14G"
    Range("A2").Value = "14G"
    Range("A3").Value = "14H"
    Range("A4").Value = "14I"
    Range("A5").Value = "07A"
    Range("A6").Value = "07B"
    Range("A7").Value = "07E"
    Range("A8").Value = "07F"
    Range("A9").Value = "07G"
    Range("A10").Value = "07I"
    Range("A11").Value = "14G020"
    Range("A12").Value = "14G021"
    Range("A13").Value = "14G022"
    Range("A14").Value = "14G023"
    Range("B1").Value = "Term"
    Range("B2").Value = "Layoff"
    Range("B3").Value = "Retirement"
    Range("B4").Value = "Death"
    Range("B5").Value = "Divorce"
    Range("B6").Value = "Divorce"
    Range("B7").Value = "Not Eligible"
    Range("B8").Value = "Not Eligible"
    Range("B9").Value = "Not Eligible"
    Range("B10").Value = "Not Eligible"
    Range("B11").Value = "Layoff"
    Range("B12").Value = "Layoff"
    Range("B13").Value = "Layoff"
    Range("B14").Value = "Layoff"

    
    Range("E1").Value = "'020"
    Range("E2").Value = "'021"
    Range("E3").Value = "'022"
    Range("E4").Value = "'023"
    
    Range("F1").Value = "ADD"
    Range("F2").Value = "ADE25"
    Range("F3").Value = "ADE50"
    Range("F4").Value = "ADE100"
    Range("F5").Value = "ADE150"
    Range("F6").Value = "ADE200"
    Range("F7").Value = "ADE250"
    Range("F8").Value = "ADE300"
    Range("F9").Value = "ADE350"
    Range("F10").Value = "ADE400"
    Range("F11").Value = "ADE450"
    Range("F12").Value = "ADE500"
    Range("F13").Value = "ADF25"
    Range("F14").Value = "ADF50"
    Range("F15").Value = "ADF100"
    Range("F16").Value = "ADF150"
    Range("F17").Value = "ADF200"
    Range("F18").Value = "ADF250"
    Range("F19").Value = "ADF300"
    Range("F20").Value = "ADF350"
    Range("F21").Value = "ADF400"
    Range("F22").Value = "ADF450"
    Range("F23").Value = "ADF500"
    
    
    Range("G2").Value = "0.73"
    Range("G3").Value = "1.45"
    Range("G4").Value = "2.9"
    Range("G5").Value = "4.35"
    Range("G6").Value = "5.8"
    Range("G7").Value = "7.25"
    Range("G8").Value = "8.7"
    Range("G9").Value = "10.15"
    Range("G10").Value = "11.6"
    Range("G11").Value = "13.05"
    Range("G12").Value = "14.5"
    Range("G13").Value = "1.1"
    Range("G14").Value = "2.2"
    Range("G15").Value = "4.4"
    Range("G16").Value = "6.6"
    Range("G17").Value = "8.8"
    Range("G18").Value = "11"
    Range("G19").Value = "13.2"
    Range("G20").Value = "15.4"
    Range("G21").Value = "17.6"
    Range("G22").Value = "19.8"
    Range("G23").Value = "22"
    Columns("G:G").NumberFormat = "0.00"
    
    Sheets("COBRA").Select
    
    Columns("AC:AC").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AC2").Value = "Combined Reason"
    Range("AC3").FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])"
    Range("AC3").AutoFill Destination:=Range("AC3:AC" & Cells(Rows.Count, "A").End(xlUp).Row)
    Columns("AD:AD").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AD2").Value = "Reason"
    Range("AD3").FormulaR1C1 = _
        "=VLOOKUP(RC[-1],'Reason Translator'!C[-29]:C[-28],2,FALSE)"
    Range("AD3").AutoFill Destination:=Range("AD3:AD" & Cells(Rows.Count, "A").End(xlUp).Row)
    
     
    'adds and formats ADD and DltDnt
    Range("DJ2").Select
    Selection.Copy
    Range("DK2").Select
    ActiveSheet.Paste
    Range("DL2").Select
    ActiveSheet.Paste
    Range("DM2").Select
    ActiveSheet.Paste
    Range("DN2").Select
    ActiveSheet.Paste
    Range("DO2").Select
    ActiveSheet.Paste
    Range("DP2").Select
    ActiveSheet.Paste
    Range("DQ2").Select
    ActiveSheet.Paste
    Range("DR2").Select
    ActiveSheet.Paste
    Range("DS2").Select
    ActiveSheet.Paste
        
    Range("DK2").Value = "ADD Fields"
    Range("DL2").Value = "ADD Number Months"
    Range("DM2").Value = "ADD Premium"
    Range("DN2").Value = "ADD Other"
    Range("DO2").Value = "12/31/2020"
    Range("DP2").Value = "Plan Coverage Begin"
    Range("DQ2").Value = "DltDntTER"
    Range("DR2").Value = "DelDntRET"
    Range("DS2").Value = "DltDntEND"
    
    Range("DK2:DP2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 48
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("DQ2:DS2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 48
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    
    'adds ADD formulas
    Range("DK3").FormulaR1C1 = "=LEFT(RC[-89],3)"
    Range("DK3").AutoFill Destination:=Range("DK3:DK" & Cells(Rows.Count, "A").End(xlUp).Row)
          
    Range("DL3").FormulaR1C1 = "=DATEDIF(RC[-81],R2C119,""M"")"
    Range("DL4").FormulaR1C1 = "=DATEDIF(RC[-81],R2C119,""M"")"
    Range("DL3:DL4").AutoFill Destination:=Range("DL3:DL" & Cells(Rows.Count, "A").End(xlUp).Row)
    
    Range("DM3").FormulaR1C1 = _
        "=VLOOKUP(RC[-91],'Reason Translator'!C[-111]:C[-110],2,FALSE)*RC[-1]"
    Range("DM3").AutoFill Destination:=Range("DM3:DM" & Cells(Rows.Count, "A").End(xlUp).Row)
    
    Range("DN3").FormulaR1C1 = _
        "=VLOOKUP(RC[-92],'Reason Translator'!C[-112]:C[-111],2,FALSE)"
    Range("DN3").AutoFill Destination:=Range("DN3:DN" & Cells(Rows.Count, "A").End(xlUp).Row)
    
    Range("DO3").FormulaR1C1 = "=RC[-84]+60"
    Range("DO3").AutoFill Destination:=Range("DO3:DO" & Cells(Rows.Count, "A").End(xlUp).Row)
    
    Range("DP3").FormulaR1C1 = "=RC[-85]+1"
    Range("DP3").AutoFill Destination:=Range("DP3:DP" & Cells(Rows.Count, "A").End(xlUp).Row)
    
    'adds DltDnt formulas
    Range("DQ3").FormulaR1C1 = "=IF(RC[-91]=""Term"",RC[-85],"""")"
    Range("DQ3").AutoFill Destination:=Range("DQ3:DQ" & Cells(Rows.Count, "A").End(xlUp).Row)
    Range("DR3").FormulaR1C1 = "=IF(RC[-92]=""Retirement"",RC[-86],"""")"
    Range("DR3").AutoFill Destination:=Range("DR3:DR" & Cells(Rows.Count, "A").End(xlUp).Row)
    Range("DS3").FormulaR1C1 = _
        "=IF(RC[-93]=""Divorce"",EDATE(RC[-119],36),EDATE(RC[-119],18))"
    Range("DS3").AutoFill Destination:=Range("DS3:DS" & Cells(Rows.Count, "A").End(xlUp).Row)
    Columns("DQ:DS").NumberFormat = "m/d/yyyy"
    
    
    
    Cells.EntireColumn.AutoFit
    Range("D1").Select
    ActiveWindow.FreezePanes = True
    Range("B1").Select
       
End Sub

DanteAmor · Aug 12, 2021

Hi cmschmitz24.
I am an enemy of eliminating rows, in addition to losing the evidence of your information, it is a relatively slow process.

I suggest the following, your data in the "COBRA" sheet, starting in cell A1, as shown in your example.
The result on the sheet "Sheet3".
The "surviving" rows will remain on Sheet3.
You will be able to compare your information with the "COBRA" sheet, make changes to the "COBRA" sheet and rerun the macro to get the result again.
Otherwise, if you delete the rows from the COBRA sheet, there is no going back.

Try the following macro:

VBA Code:

Sub Move_Delete_based_on_criteria()
  Dim sh As Worksheet
  Dim rng As Range
  Dim fec As Date
  Dim a As Variant, b As Variant, ky As Variant, filas As Variant
  Dim i As Long, j As Long, f As Long, n As Long
  Dim llave1 As String, llave2 As String
  Dim dic1 As Object, dic2 As Object
  
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  
  Set sh = Sheets("COBRA")
  a = sh.Range("A1", sh.Cells(sh.Range("A" & Rows.Count).End(3).Row, _
                     sh.Cells(2, Columns.Count).End(1).Column)).Value
  Set rng = Union(sh.Range("A1"), sh.Range("A2"))
  
  For i = 3 To UBound(a, 1)
    If Date - 90 <= a(i, 35) And Date + 90 >= a(i, 35) Then
      llave1 = a(i, 1) & "|" & a(i, 3)
      If Not dic1.exists(llave1) Then
        dic1(llave1) = a(i, 35) & "|" & i
      Else
        fec = Split(dic1(llave1), "|")(0)
        If a(i, 35) > fec Then
          dic1(llave1) = a(i, 35) & "|" & i
        End If
      End If
      
      llave2 = a(i, 1) & "|" & a(i, 3) & "|" & a(i, 35)
      If Not dic2.exists(llave2) Then
        dic2(llave2) = i
      Else
        dic2(llave2) = dic2(llave2) & "|" & i
      End If
    End If
  Next
  
  For Each ky In dic1.keys
    filas = Split(dic2(ky & "|" & Split(dic1(ky), "|")(0)), "|")
    n = 59
    For f = 0 To UBound(filas)
      If f = 0 Then
        i = filas(f)
        Set rng = Union(rng, sh.Range("A" & i))
      Else
        For j = 51 To 58
          sh.Cells(i, n) = a(filas(f), j)
          n = n + 1
        Next
      End If
    Next
  Next
  
  With Sheets("Sheet3")
    .Cells.ClearContents
    rng.EntireRow.Copy .Range("A1")
  End With
End Sub

DanteAmor · Aug 13, 2021

I made an enhacement to the code, in case the numbers in column AY are not ordered.

VBA Code:

Sub Move_Delete_based_on_criteria()
  Dim sh As Worksheet
  Dim rng As Range
  Dim fec As Date
  Dim a As Variant, b As Variant, ky As Variant, filas As Variant
  Dim i As Long, j As Long, f As Long, n As Long, c As Long
  Dim llave1 As String, llave2 As String
  Dim dic1 As Object, dic2 As Object
  
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  
  Set sh = Sheets("COBRA")
  a = sh.Range("A1", sh.Cells(sh.Range("A" & Rows.Count).End(3).Row, _
                     sh.Cells(2, Columns.Count).End(1).Column)).Value
  Set rng = Union(sh.Range("A1"), sh.Range("A2"))
  
  For i = 3 To UBound(a, 1)
    If Date - 90 <= a(i, 35) And Date + 90 >= a(i, 35) Then
      llave1 = a(i, 1) & "|" & a(i, 3)
      If Not dic1.exists(llave1) Then
        dic1(llave1) = a(i, 35) & "|" & i
      Else
        fec = Split(dic1(llave1), "|")(0)
        If a(i, 35) > fec Then
          dic1(llave1) = a(i, 35) & "|" & i
        End If
      End If
      
      llave2 = a(i, 1) & "|" & a(i, 3) & "|" & a(i, 35)
      If Not dic2.exists(llave2) Then
        dic2(llave2) = i
      Else
        dic2(llave2) = dic2(llave2) & "|" & i
      End If
    End If
  Next
  
  For Each ky In dic1.keys
    filas = Split(dic2(ky & "|" & Split(dic1(ky), "|")(0)), "|")
    For f = 0 To UBound(filas)
      If f = 0 Then
        i = filas(f)
        Set rng = Union(rng, sh.Range("A" & i))
      Else
        For j = 51 To 58
          If j = 51 Then n = ((filas(f) - 1) * 8) + j
          sh.Cells(i, n) = a(filas(f), j)
          n = n + 1
        Next
      End If
    Next
  Next
  
  With Sheets("Sheet3")
    .Cells.ClearContents
    rng.EntireRow.Copy .Range("A1")
  End With
End Sub

cmschmitz24 · Aug 14, 2021

Hi, thanks for your work but your macro isn't doing what I need it to do. It appears to be copy/paste-ing duplicate dependent information but it's not deleting the row and the important thing is that those rows I will need on the main sheet since they are within the needed timeframe. Maybe let's start with one thing first -

In column AH, I need to have the entire row with any date outside of today's date +/- 90 days to be either deleted or moved to a different sheet.

After that has been tested and working, then I'll need to look at moving dependent information in columns AY-BF, etc. to the appropriate line.

DanteAmor · Aug 14, 2021

Did you try the macro?
I told you that the macro was not going to delete records.
I understand that they should be deleted. but you checked the records on sheet3, just to verify that those records are the ones that should remain.
If you confirm that to me, I will gladly make the changes to delete records. but I need you to take the test.
I did the test with your sample and actually the correct records remain on sheet3.

DanteAmor · Aug 16, 2021

cmschmitz24 said:
but it's not deleting the row and the important thing is that those rows I will need on the main sheet

Try this macro with the fixed code. Now it does delete the records.

VBA Code:

Sub Move_Delete_based_on_criteria()
  Dim sh As Worksheet, rng As Range
  Dim a As Variant, b As Variant, ky As Variant, filas As Variant
  Dim i As Long, j As Long, f As Long, m As Long, n As Long
  Dim lr As Long, lc As Long
  Dim llave1 As String, llave2 As String
  Dim dic1 As Object, dic2 As Object
  Dim fec As Date
  
  Application.ScreenUpdating = False
  
  Set sh = Sheets("COBRA")
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  
  lc = sh.Cells(2, Columns.Count).End(1).Column + 2
  lr = sh.Range("A" & Rows.Count).End(3).Row
  a = sh.Range("A1", sh.Cells(lr, lc)).Value
  
  Set rng = sh.Range("A" & lr + 1)
  For i = 3 To UBound(a, 1)
    If Date - 90 <= a(i, 35) And Date + 90 >= a(i, 35) Then
      llave1 = a(i, 1) & "|" & a(i, 3)
      If Not dic1.exists(llave1) Then
        dic1(llave1) = a(i, 35) & "|" & i
      Else
        fec = Split(dic1(llave1), "|")(0)
        If a(i, 35) > fec Then
          dic1(llave1) = a(i, 35) & "|" & i
        End If
      End If
      
      llave2 = a(i, 1) & "|" & a(i, 3) & "|" & a(i, 35)
      If Not dic2.exists(llave2) Then
        dic2(llave2) = i
      Else
        dic2(llave2) = dic2(llave2) & "|" & i
      End If
    End If
  Next
  
  For Each ky In dic1.keys
    filas = Split(dic2(ky & "|" & Split(dic1(ky), "|")(0)), "|")
    For f = 0 To UBound(filas)
      If f = 0 Then
        i = filas(f)
        a(i, lc) = "x"
      Else
        For j = 51 To 58
          If j = 51 Then
            m = a(filas(f), 51)
            n = ((m - 1) * 8) + j
          End If
          sh.Cells(i, n) = a(filas(f), j)
          n = n + 1
        Next
      End If
    Next
  Next
  
  For i = 3 To UBound(a, 1)
    If a(i, lc) = "" Then Set rng = Union(rng, sh.Range("A" & i))
  Next
  rng.EntireRow.Delete
  Application.ScreenUpdating = True
End Sub

cmschmitz24 · Aug 16, 2021

DanteAmor said:
Did you try the macro?
I told you that the macro was not going to delete records.
I understand that they should be deleted. but you checked the records on sheet3, just to verify that those records are the ones that should remain.
If you confirm that to me, I will gladly make the changes to delete records. but I need you to take the test.
I did the test with your sample and actually the correct records remain on sheet3.

Your macro was moving rows to sheet 3, but the wrong rows based on the date frame in column AH.

cmschmitz24 · Aug 16, 2021

cmschmitz24 said:
Your macro was moving rows to sheet 3, but the wrong rows based on the date frame in column AH.

And, I forgot to clarify that the rows the macro is moving to sheet 3 are not being deleted from "COBRA"

DanteAmor · Aug 16, 2021

Try the macro from post #6, delete the records as you requested.

cmschmitz24 said:
the most recent date in column AI should stay.

The macro checks the dates in the AI column.

cmschmitz24 · Aug 16, 2021

It works so far! I will have to keep testing future things to make sure, but thank you.

Macro Help - Move/Delete based on cell criteria

cmschmitz24

Board Regular

Excel Facts

DanteAmor

Well-known Member

DanteAmor

Well-known Member

cmschmitz24

Board Regular

DanteAmor

Well-known Member

DanteAmor

Well-known Member

cmschmitz24

Board Regular

cmschmitz24

Board Regular

DanteAmor

Well-known Member

cmschmitz24

Board Regular

Similar threads

Forum statistics

Share this page

Macro Help - Move/Delete based on cell criteria

Board Regular

Excel Facts

Well-known Member

Well-known Member

Board Regular

Well-known Member

Well-known Member

Board Regular

Board Regular

Well-known Member

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock