how to populate a column with a string taking in consideration 5 different criteria

FaKest · Sep 24th 2020

I need help to populate the Column C on sheet named Interdiction Review with a string "Consider" (need to run the code for sheet interunion review be created)

the code is placed on Thisworkbook

on Column C need to be populate with a string "Consider" is:

- consumer has only 1 input (this is done)

- consumer has 2 to 4 inputs and total volume is <10K

- consumer Level (based on the rules below) is Level 2 or Level 3 (columns with levels values are CV and CW from Start sheet)

- If Review Period is = 60 days and the maximum input date is older than 30 days -- (review period is a dropdown on sheet named SStart, input dates are located on columns E and AG on Start sheet)

-If Review Period is = 1year and the maximum input date is older than 90 days --- (review period is a dropdown on sheet named SStart, input dates are located on columns E and AG on Start sheet)

- f Review Period is = 5year and the maximum input date is older than 180 days --- (review period is a dropdown on sheet named SStart, input dates are located on columns E and AG on Start sheet)

The problem is how to populate the column C taking in consideration so many criteria in a way that the code will not transposes each other .

I tried to use excel formula on VBA, however I cold not get the result I wished.

what would be the best way to do it? how should I start?

7exemplo. xlsm (1).xlsm

for - consumer has only 1 input (this is done) criteria the code used was:

Code

'Consumer has only 1 Transaction, the value on Interdiction Review Tab on Column C will be Consider
Dim wsStart As Worksheet, lastRow1 As Long, wsFinal As Worksheet
Dim dict As Object, rw As Range, v, v2, k, m
Set wsStart = ActiveWorkbook.Sheets("Start")
Set wsFinal = ActiveWorkbook.Sheets("Interdiction Review")
lastRow1 = wsStart.Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set dict = CreateObject("Scripting.Dictionary")
For Each rw In wsStart.Range("A2:AJ" & lastRow1).Rows
v = rw.Cells(8).Value
v2 = rw.Cells(36).Value
If Len(v) = 0 Or Len(v2) = 0 Then
v = rw.Cells(7).Value
v2 = rw.Cells(35).Value
End If
dict(v) = dict(v) + 1
dict(v2) = dict(v2) + 1
Next rw
For Each k In dict
If dict(k) = 1 Then
m = Application.Match(k, wsFinal.Columns(1), 0)
If Not IsError(m) Then wsFinal.Cells(m, 3).Value = "Consider"
End If
Next k

Display More

not sure if I could use the code above for all the criteria at the same time.

FaKest · Sep 24th 2020

Hello all,

I managed to continue the code and to add more criteria to it.

Code

'Interdction Review Tab, column C
Sheets("Interdiction Review").Columns(3).Font.Bold = True
Sheets("Interdiction Review").Columns(3).HorizontalAlignment = xlCenter
'Consumer has only 1 Transaction, the value on Interdiction Review Tab on Column C will be Consider
Dim wsStart As Worksheet, lastRow1 As Long, wsFinal As Worksheet
Dim dict As Object, rw As Range, v, v2, k, m
Dim wsSSart As Worksheet
Dim dateDifference As Long
Dim SStartSelection As String
Dim isConsider As Boolean
Set wsSSart = ActiveWorkbook.Sheets("SStart")
Set wsStart = ActiveWorkbook.Sheets("Start")
Set wsFinal = ActiveWorkbook.Sheets("Interdiction Review")
lastRow1 = wsStart.Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set dict = CreateObject("Scripting.Dictionary")
SStartSelection = wsSSart.Cells(7, "A").Value
For Each rw In wsStart.Range("A2:AJ" & lastRow1).Rows
v = rw.Cells(8).Value
v2 = rw.Cells(36).Value
If Len(v) = 0 Or Len(v2) = 0 Then
v = rw.Cells(7).Value
v2 = rw.Cells(35).Value
End If
dict(v) = dict(v) + 1
dict(v2) = dict(v2) + 1
Next rw
For Each k In dict
isConsider = False
m = Application.Match(k, wsFinal.Columns(1), 0)
wsFinal.Cells(m, 7).FormulaArray = wsFinal.Cells(m, 7).Formula
dateDifference = DateDiff("D", wsFinal.Cells(m, 7).Value, Date)
If dict(k) = 1 Then
isConsider = True
ElseIf dict(k) >= 2 And dict(k) <= 4 And wsFinal.Cells(m, 6).Value <= 10000 Then
isConsider = True
End If
If StrComp(SStartSelection, "60 Days") = 0 And dateDifference > 30 Then
isConsider = True
ElseIf StrComp(SStartSelection, "1 Year") = 0 And dateDifference > 90 Then
isConsider = True
ElseIf StrComp(SStartSelection, "5 Years") = 0 And dateDifference > 180 Then
isConsider = True
End If
If isConsider Then
If Not IsError(m) Then wsFinal.Cells(m, 3).Value = "Consider"
End If
Next k

Display More

What I am missing is to link the consumer Level with the last date of his/she input.
60 days and the maximum input date is older than 30 days and the consumer Level is 2 or 3

1 year and the maximum input date is older than 90 days and the consumer Level is 2 or 3

5 year and the maximum input date is older than 180 days and the consumer Level is 2 or 3

any advises how to do it?

thank you

dangelor · Sep 24th 2020

Would testing the Start tab columns CV and CW give you the results you want?

FaKest · Sep 26th 2020

Quote from dangelor

Would testing the Start tab columns CV and CW give you the results you want?

I Tried to and I created a new part for the code, however it is taking the information from the wrong column and I dont know why. 13.trytryagain.xlsm

Code

'Interdction Review Tab, column C
Sheets("Interdiction Review").Columns(3).Font.Bold = True
Sheets("Interdiction Review").Columns(3).HorizontalAlignment = xlCenter
'Consumer has only 1 Transaction, the value on Interdiction Review Tab on Column C will be Consider
Dim wsStart As Worksheet, lastRow1 As Long, wsFinal As Worksheet
Dim dict As Object, rw As Range, v, v2, k, m, lin
Dim wsSSart As Worksheet
Dim dateDifference As Long
Dim SStartSelection As String
Dim isConsider As Boolean
Dim valid_col(1) As Integer
Dim lvl As Boolean
Set wsSSart = ActiveWorkbook.Sheets("SStart")
Set wsStart = ActiveWorkbook.Sheets("Start")
Set wsFinal = ActiveWorkbook.Sheets("Interdiction Review")
lastRow1 = wsStart.Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set dict = CreateObject("Scripting.Dictionary")
SStartSelection = wsSSart.Cells(7, "A").Value
lvl = False
For Each rw In wsStart.Range("A2:AJ" & lastRow1).Rows
v = rw.Cells(8).Value
v2 = rw.Cells(36).Value
If Len(v) = 0 Or Len(v2) = 0 Then
v = rw.Cells(7).Value
v2 = rw.Cells(35).Value
End If
dict(v) = dict(v) + 1
dict(v2) = dict(v2) + 1
Next rw
For Each k In dict
isConsider = False
m = Application.Match(k, wsFinal.Columns(1), 0)
wsFinal.Cells(m, 7).FormulaArray = wsFinal.Cells(m, 7).Formula
dateDifference = DateDiff("D", wsFinal.Cells(m, 7).Value, Date)
If dict(k) = 1 Then
isConsider = True
ElseIf dict(k) >= 2 And dict(k) <= 4 And wsFinal.Cells(m, 6).Value <= 10000 Then
isConsider = True
End If
If StrComp(SStartSelection, "60 Days") = 0 And dateDifference > 30 Then
isConsider = True
ElseIf StrComp(SStartSelection, "1 Year") = 0 And dateDifference > 90 Then
isConsider = True
ElseIf StrComp(SStartSelection, "5 Years") = 0 And dateDifference > 180 Then
isConsider = True
End If
'Client number
If wsStart.Cells(2, 8) <> "" Then
valid_col(0) = 8
valid_col(1) = 36
Else
valid_col(0) = 7
valid_col(1) = 35
End If
'Level verification
For lin = 2 To lastRow1
If wsStart.Cells(lin, valid_col(0)) = k Then
If wsStart.Cells(lin, 100).Value = "Level 2" Or wsStart.Cells(lin, 100).Value = "Level 3" Then
lvl = True
Exit For
End If
End If
If wsStart.Cells(lin, valid_col(1)) = k Then
If wsStart.Cells(lin, 101).Value = "Level 2" Or wsStart.Cells(lin, 101).Value = "Level 3" Then
lvl = True
Exit For
End If
End If
Next lin
If isConsider And lvl Then
If Not IsError(m) Then wsFinal.Cells(m, 3).Value = "Consider"
End If
Next k
End Sub

Display More

The criteria I have for this code to run and add "Consider" in the column C are:

If consumer meets one of these rules, value should be set to Consider:

• Consumer has only 1 Transaction -- (is done)

• Consumer has 2 - 4 Transactions but total volume < 10,000 USD --- (is done)

• Consumer Level (based on rule below) is Level 2 or Level 3 --- ( this information are on column CV and CW)

• If dropdown is 60 Days and max transaction date is older than 30 days

• if dropdown is 1 year and max transaction date is older than 90 days

• If dropdown is 5 years and max transaction date is older than 180 days

It seems that my code is looking in the wrong column. ex:
client number 3 are on columns H and AJ (so for this client need to check the column CV when checking the lines where he is on column H; and CW when the client number are on column AJ (if client number 3 will be Level 2 or Level 3 on column CV or CW then it need to have a consider). However, if you filter the column H and later the column AJ the client number 3 level will always be Level 1.

The level for column CV is when the client number is on column H

The level for column CW is when client is on Column AJ

FaKest · Sep 26th 2020

I asked here as well

https://stackoverflow.com/q/64072977/13121714

dangelor · Sep 27th 2020

Does this work for you?

Code

Sub test_v2()
Dim ws As Worksheet
Dim lRow As Long, lRowIR As Long
Dim mylist(1) As String
Dim v As Variant, i As Long
Set ws = Worksheets("Start")
With Worksheets.Add(after:=ws)
.Name = "Interdiction Review"
With .Range("A1:I1")
.Value = Array("Number", "Name", "Consider", "YES?", "Total Number of TXN", "Total Principal", "Max Transaction Date", "Level", "Previous Code")
.Interior.ColorIndex = 16
.Font.Name = "MS Sans Serif"
.Font.Size = 10
.Font.Color = vbWhite
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
.AutoFilter
End With
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
If ws.Range("H2") = "" Then
.Range("A2:A" & lRow).Value = ws.Range("G2:G" & lRow).Value
.Range("H2:H" & lRow).Value = ws.Range("CW2:CW" & lRow).Value
Else
.Range("A2:A" & lRow).Value = ws.Range("H2:H" & lRow).Value
.Range("H2:H" & lRow).Value = ws.Range("CV2:CV" & lRow).Value
End If
.Range("B2:B" & lRow).Value = ws.Range("I2:I" & lRow).Value
lRowIR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If ws.Range("AJ2") = "" Then
ws.Range("AI2:AI" & lRow).Copy .Cells(lRowIR, 1)
ws.Range("CW2:CW" & lRow).Copy .Cells(lRowIR, 8)
Else
ws.Range("AJ2:AJ" & lRow).Copy .Cells(lRowIR, 1)
ws.Range("CV2:CV" & lRow).Copy .Cells(lRowIR, 8)
End If
ws.Range("AK2:AK" & lRow).Copy .Cells(lRowIR, 2)
With .Sort
.SortFields.Clear
.SortFields.Add Key:=Cells(1, 1), SortOn:=xlSortOnValues, Order:=xlAscending
.SetRange Cells(1, 1).CurrentRegion
.Header = xlYes
.Apply
End With
lRowIR = .Cells(Rows.Count, 1).End(xlUp).Row
With .Range("E2:E" & lRowIR)
.Formula = "=Countif(A:A,A2)"
.Value = .Value
End With
.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
mylist(0) = "--"
mylist(1) = "No"
With .Range("D2:D" & lRowIR)
.Validation.Delete
.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=Join(mylist, ",")
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""No"""
.Font.ColorIndex = 3
.FormatConditions(Range("D2:D" & lRowIR).FormatConditions.Count).SetFirstPriority
End With
With .Range("D2:D" & lRowIR).FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = RGB(255, 153, 204)
.TintAndShade = 0
End With
.Range("D2:D" & lRowIR).FormatConditions(1).StopIfTrue = False
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
lRowIR = .Cells(Rows.Count, 1).End(xlUp).Row '+ 1
If ws.Range("H2").Value <> "" Then
.Range("F2:F" & lRowIR).Formula = "=SUMIF(Start!$H$2:$H$" & lRow & ", 'Interdiction Review'!A2,Start!$A$2:$A$" & lRow & ")+SUMIF(Start!$AJ$2:$AJ$" & lRow & ",'Interdiction Review'!A2,Start!$A$2:$A$" & lRow & ")"
Else
.Range("F2:F" & lRowIR).Formula = "=SUMIF(Start!$G$2:$G$" & lRow & ", 'Interdiction Review'!A2,Start!$A$2:$A$" & lRow & ")+SUMIF(Start!$AI$2:$AI$" & lRow & ",'Interdiction Review'!A2,Start!$A$2:$A$" & lRow & ")"
End If
.Range("G2:G" & lRowIR).Formula = "=MAX(MAX(IF(Start!$H$2:$H$" & lRow & "= 'Interdiction Review'!A2,Start!$E$2:$E$" & lRow & ")),MAX(IF(Start!$AJ$2:$AJ$" & lRow & "='Interdiction Review'!A2,Start!$AG$2:$AG$" & lRow & ")))"
.Range("G2:G" & lRowIR).FormulaArray = Sheets("Interdiction Review").Range("G2:G" & lRowIR).Formula
v = .Cells(1, 1).CurrentRegion
For i = 2 To UBound(v)
If v(i, 5) = 1 Then v(i, 3) = "Consider"
If v(i, 5) > 1 And v(i, 5) < 5 And v(i, 6) < 10000 Then v(i, 3) = "Consider"
If v(i, 8) = "Level 2" Or v(i, 8) = "Level 3" Then v(i, 3) = "Consider"
Next i
.Cells(1, 1).CurrentRegion = v
.Columns(1).NumberFormat = "@"
.Columns(1).HorizontalAlignment = xlLeft
.Columns("A:I").AutoFit
.Columns(3).Font.Bold = True
.Columns(3).HorizontalAlignment = xlCenter
.Columns(5).HorizontalAlignment = xlCenter
.Columns(6).HorizontalAlignment = xlCenter
.Columns(6).NumberFormat = "$#,##0.00_);($#,##0.00)"
.Columns(7).HorizontalAlignment = xlCenter
.Columns(7).NumberFormat = "mm/dd/yyyy"
End With
End Sub

Display More

FaKest · Sep 27th 2020

Quote from FaKest

I asked here as well

https://stackoverflow.com/q/64072977/13121714

thank you so much Dangelor, It is working
Thank for your time and help ☺️

dangelor · Sep 27th 2020

Glad to hear it!

FaKest · Sep 28th 2020

Quote from dangelor

Glad to hear it!

Sr. Dangelor,

Sorry to disturb you, but maybe could you help me to understand and to correct code with a dictionary for populating the column I on interdiction Review Tab?

If so, in this case, should I create a new Threare?

Thank you

dangelor · Sep 28th 2020

What should populate column I?

FaKest · Monday, 5:53 pm

SR. Dangelor

Thank you so much for your time and help.

I was able to finish the column I.

Thank you

Quote from dangelor

What should populate column I?

dangelor · Monday, 10:37 pm

You're welcome. Good luck!

how to populate a column with a string taking in consideration 5 different criteria

Share

Tags