0
votes

Not sure how to finish this code with steps outlined below it. Any help appreciated

Sub Test()
Dim Value As Double

    For Each Value In ThisWorkbook.Sheets("Sheet").Range("V17:V57")
        If Value.ThisWorkbook.Sheets("Sheet").Range("V17:V57") = 0 Then...
        ...
        End If
End Sub

Check if 0 exists in range

If true...

  • reset my 'Data Validation' Source range of cell on same worksheet that has a drop down list that depends on the new range (ie from cell Q17 down to same row where 0 value is). Note this Source range is located 5 columns to the left of column where 0 value is and the first row of this range is the same row (17) as where range containing 0 value starts

Else...

  • find and select cell with least negative value, by using something like Application.WorksheetFunction.FormulaArray ("MAX(IF(V17:V37<=0,V17:V37),MIN(V17:V37))")

  • once cell found/selected, perform goal seek to set selected cell to set it to 0 by changing value in cell 4 cells to left of selected cell

  • Automatically update 'Data Validation' Source range as above

For when 0 exists, I'm trying this code but how can I set validation range based on a corresponding range of cells in another column of my data table? Cell H24 is where my drop down list is

Dim rng As Range
For Each rng In ThisWorkbook.Sheets("Sheet").Range("V17:V57")
    If rng.Value = 0 Then
    ThisWorkbook.Sheets("Sheet").Select
    Range ("H24").Select
       With Selection.Validation
      .Delete
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=Sheet!$V$17:$V" & ??
    Else...

The following code gives debug error at evaluation line. Overall code block needs simplifying...too many If, For, Next?? I've annotated for clarity. Need help also with the goal seek line.

Dim rng As Range
For Each rng In ThisWorkbook.Sheets("Sheet").Range("V17:V57")
    If rng.Value <> 0 Then
    rng = Application.WorksheetFunction.FormulaArray("MAX(IF(V17:V57<=0,V17:V57),MIN(V17:V57))") 'this formula searches for the least min number in the range
    rng.Select
    Range("selected cell").GoalSeek Goal:=0, ChangingCell:=Range("cell 5 columns left of selected cell")...this line makes selected cell = 0 
    Exit For
    End If
Next rng
2
Dim rng as Range: For Each rng In ThisWorkbook.Worksheets("Sheet").Range("V17:V57") : If rng.Value = 0 Then.....:Else....:End If........ - QHarr
Not sure how to deal with the validation. As per edit to original question - Nui

2 Answers

1
votes

Let's say that you want to find the value "3" over the range A1:B10:

Set given_range = ThisWorkbook.Worksheets("Sheet1").Range("A1:B10")
given_range.Select
Set found_value = Selection.Find("3")

And if you're looking for its address:

value_address = found_value.Address(0,0)

Using the (0,0) at the end will return the address without any $ (B3 instead of $B$3)

As an extra: if you want to know the row or the column, do as follows

value_column = Split(found_value.Address, "$")(1)
value_row = Split(found_value.Address, "$")(2)
0
votes
'To check if an element is within a specific Array, Object, Range, String, etc.
Public Function isInArray(ByVal itemSearched As Variant, ByVal aArray As Variant) As Boolean
Dim item As Variant

If VarType(aArray) >= vbArray Or VarType(aArray) = vbObject Or VarType(aArray) = vbDataObject Or TypeName(aArray) = "Range" Then
    For Each item In aArray
        If itemSearched = item Then
            isInArray = True
            Exit Function
        End If
    Next item
    isInArray = False
ElseIf VarType(aArray) = vbString Then
    isInArray = InStr(1, aArray, itemSearched, vbBinaryCompare) > 0 'Comparing character by character
Else
    On Error Resume Next
    isInArray = Not IsError(Application.Match(itemSearched, aArray, False)) 'Slow on large arrays
    Err.Clear: On Error GoTo 0
End If

End Function