Appendix Thread. ( Codes for other Threads, etc.) Event Coding Drpdown Data validation

**DocAElstein** · 04-21-2020, 01:11 PM

VBA Solution to above, and answer to this Post
http://www.excelfox.com/forum/showth...ll=1#post13102

VBA answer

Put columns in arrays

_Row\^Col	D
1	Open
2	1087
3	148.05
4	265
5	30.4

arrD() =

1087

148.05

265

30.4

_Row\^Col	H
1	LTP
2	1079.9
3	146.5
4	267.15
5	29.95

arrH() =

1079.9

146.5

267.15

29.95

_Row\^Col	K
1
2	1090.69
3	147.95
4	264.47
5	30

arrK() ( initial ) =

1090.69

147.95

264.47

30

The macro below manipulates the contents of arrK() as per the question requirement, then pastes the modified array over the initial values

Code:

Sub ChangeSecondNumberAfterDecimalConditionally() ' http://www.excelfox.com/forum/showthread.php/2457-change-the-second-number-after-decimal-conditionally
Rem 1 Worksheets info
Dim Wb1 As Workbook
 Set Wb1 = Workbooks("SAMPLE1 18Apr2020.xlsx")  '  Workbooks("1.xls")        ' CHANGE TO SUIT
Dim Ws1 As Worksheet
 Set Ws1 = Wb1.Worksheets.Item(1)
Dim Lrow As Long
 Let Lrow = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row      '   http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466      Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Rem 2 ranges of interest, D H and K , are placed in 1 column arrays, rows from 2 to Lrow
 Dim arrD() As Variant, arrH() As Variant, ArrK() As Variant  '  The  .Value  property used below returns its values in a field of variant type elements, so to avoiud a type mismatch we must  Dim  here appropriately
 Let arrD() = Ws1.Range("D2:D" & Lrow & "").Value: Let arrH() = Ws1.Range("H2:H" & Lrow & "").Value: Let ArrK() = Ws1.Range("K2:K" & Lrow & "").Value
Rem 3 Manipulate  arrK()  as per requiremnt   For all data rows, we compare column H to column D. If column H is greater than column D , then we adjust the value in column K up to the nearest multiple of .05. If column H is less than column D , then we adjust the value in column K down to the nearest multiple of .05. ( If the value in column K is an exact multiple of .05, then no action is to be taken )   http://www.excelfox.com/forum/showthread.php/2457-change-the-second-number-after-decimal-conditionally?p=13099&viewfull=1#post13099
Dim Cnt
    For Cnt = 1 To Lrow - 1 ' range is row 2 to Lrow-1, array will be 1 to Lrow-1
        If Int(Round((ArrK(Cnt, 1) / 0.05), 2)) - Round((ArrK(Cnt, 1) / 0.05), 2) = 0 Then
        ' do nothing because we have exact mulktiple of .05
        Else ' case K is not an exact multiple of .05
            If arrH(Cnt, 1) < arrD(Cnt, 1) Then
             Let ArrK(Cnt, 1) = Int(ArrK(Cnt, 1) * 100 / 5) * 5 / 100 '    =INT(K2*100/5)*5/100     =K2*100/5    =INT(L2)   =M2*5/100   =INT(L2)*5/100   =INT(K2*100/5)*5/100   http://www.excelfox.com/forum/showthread.php/2457-change-the-second-number-after-decimal-conditionally?p=13100&viewfull=1#post13100
            ElseIf arrH(Cnt, 1) > arrD(Cnt, 1) Then
             Let ArrK(Cnt, 1) = (Int(ArrK(Cnt, 1) * 100 / 5) * 5 / 100) + 0.05
            Else ' case H = D
             Let ArrK(Cnt, 1) = "H is equal to D"
            End If
        End If
    Next Cnt
Rem 4 Paste out modified array over original values
 Let Ws1.Range("K2:K" & Lrow & "").Value = ArrK()
End Sub