VBA macro to add flag to column, with predefined parameters

Hi

I need help with a VBA macro. a few steps and logic.
File already open via import from text

4 step message box:
1. Enter value
2. Enter symbol
3. Choose column for flagging
4. Choose column to match

The value entered (usually around 1000-2500) will be used to add the symbol in the chosen column for every multiple instance, but to the nearest populated row in another chosen column
i.e 1000 entered = 1000,2000,3000, and so on to end of doc but would be something like 1005, 2008, 2999, 4001 when matched against the other column

I've created a 20k sample file. In sample file. Add flag to C, to the nearest * populated in A

Data will have a sequence column if this will be useful for anyone to use, feel free..

Many thanks for any help!

FYI, cross-posted: https://www.excelforum.com/excel-pro...arameters.html

Not understanding. Enter value and symbol where? Are these the data already in file? Choose columns how? What should results look like?

so many msgbox...

Code:

---

Sub test()
    Dim myList, i&, s(1), x(1), myRow&, myItem, LR&
    myList = Array(Array("Symbol", ""), Array("Item", ""), Array("Flag", ""))
    LR = Cells.SpecialCells(11).Row
    Application.DisplayAlerts = False
    For i = 0 To 2
        On Error Resume Next
        myList(i)(1) = Application.InputBox("Select column for " & myList(i)(0), Type:=8).Column
        If myList(i)(1) = "" Then Exit Sub
        myList(i)(1) = Range(Cells(2, myList(i)(1)), Cells(LR, myList(i)(1))).Address
        On Error GoTo 0
    Next
    s(0) = InputBox("Enter Symbol"): If s(0) = "" Then Exit Sub
    If Application.CountIf(Range(myList(0)(1)), s(0)) = 0 Then MsgBox "No symbol found", , s(0): Exit Sub
    If Not IsNumeric(s(0)) Then s(0) = Chr(34) & s(0) & Chr(34)
    s(1) = Application.InputBox("Enter Value", Type:=1)
    x(0) = Evaluate("max(if((" & myList(0)(1) & "=" & s(0) & ")*(" & myList(1)(1) & _
                    "+0<=" & s(1) & ")," & myList(1)(1) & "+0))")
    x(1) = Evaluate("min(if((" & myList(0)(1) & "=" & s(0) & ")*(" & myList(1)(1) & _
                    "+0>=" & s(1) & ")," & myList(1)(1) & "+0))")
    If x(0) = 0 Then
        myItem = x(1)
    Else
        If s(1) - x(0) < x(1) - s(1) Then
            myItem = x(0)
        Else
            myItem = x(1)
        End If
    End If
    myRow = Evaluate("match(" & myItem & "," & myList(1)(1) & "+0,0)")
    Cells(myRow + 1, 3) = "x"
    Application.Goto Cells(myRow, 3)
End Sub

---

Thanks Jindon for your help with this! Much appreciated :)
It correctly enters the first symbol value, but can you add code to loop through to the end of the file and add the symbol for every increment of the entered value?
i.e 1000 entered would flag around 1000,2000,3000 till end

If the code is not working as you want, I don't think I understand what you are trying to do.

It will help if you upload a workbook showing your desired results in new sheet with every parameters.

Sorry mate, not the best at explaining this!
I have uploaded a new doc to this reply. Column C has a # populated every 1000 rows to the nearest populated cell in Column A (if I were to enter 1000 in 'Enter Value' msg box)

Hope this helps?

The difference between csv in post #1 and post #7 is one have 2002 ros\ws and other have only 5988 rows and they are exactly the same up to 5899 row.

What are the parameters you enter?

I trimmed the file so it has less rows, now at 6k~. Enough rows to test the code but not so many that for entering manually would take long
I manually entered the # in column C to show the desired results

Select column for symbol: $A:$A
Select column for item: $B:$B
Select column for flag: $C:$C
Enter symbol: *
Enter Value: 1000

OK
When * is entered to symbol and 1000 entered to the value, my code finds nesarest value that have same symbol that is 0000000998 on row 999 and place "x" to col.C.

Did you check above?

Quote:

---

i.e 1000 entered would flag around 1000,2000,3000 till end

---

Sorry, but I don't understand the meaning of above...

I'm not sure how best to explain... but can the code loop through the search ot the next 1000 = 2000~ and then 3000~

So the data file is flagged with x in Ccol C every 1000~ rows until end of file
My attachment (attached to this reply) will show the flags in col C every 1000 to nearest 8 in Col A
Pic of data with applied filter to also show this
http://www.vbaexpress.com/forum/imag...AASUVORK5CYII=

Detailed error checking has not been implemented...

Code:

---

Sub test()
    Dim myList, i&, s(3), x(1), myRow&, myItem, LR&
    myList = Array(Array("Symbol", ""), Array("Item", ""), Array("Flag", ""))
    LR = Cells.SpecialCells(11).Row
    Application.DisplayAlerts = False
    For i = 0 To 2
        On Error Resume Next
        myList(i)(1) = Application.InputBox("Select column for " & myList(i)(0), Type:=8).Column
        If myList(i)(1) = "" Then Exit Sub
        myList(i)(1) = Range(Cells(2, myList(i)(1)), Cells(LR, myList(i)(1))).Address
        On Error GoTo 0
    Next
    s(0) = InputBox("Enter Symbol"): If s(0) = "" Then Exit Sub
    If Application.CountIf(Range(myList(0)(1)), s(0)) = 0 Then MsgBox "No symbol found", , s(0): Exit Sub
    s(2) = s(0): If Not IsNumeric(s(2)) Then s(2) = Chr(34) & s(0) & Chr(34)
    s(3) = Application.InputBox("Enter Value", Type:=1)
    s(1) = s(3)
    Application.ScreenUpdating = False
    Do
        myRow = GetNearestRow(myList, s, LR)
        If myRow > 0 Then
            Cells(myRow, 3) = "x"
            s(1) = s(1) + s(3)
        End If
    Loop While s(1) <= LR
    Application.ScreenUpdating = True
    End Sub


Function GetNearestRow&(myList, s, LR&)
    Dim x(1), myItem
    If s(1) = 21000 Then Stop
    x(0) = Evaluate("max(if((" & myList(0)(1) & "=" & s(2) & ")*(" & myList(1)(1) & _
            "+0<=" & s(1) & ")," & myList(1)(1) & "+0))")
    x(1) = Evaluate("min(if((" & myList(0)(1) & "=" & s(2) & ")*(" & myList(1)(1) & _
            "+0>=" & s(1) & ")," & myList(1)(1) & "+0))")
    If (x(0) = 0) + (x(1) = 0) Then
        myItem = Application.Max(x(0), x(1))
    Else
        If s(1) - x(0) < x(1) - s(1) Then
            myItem = x(0)
        Else
            myItem = x(1)
        End If
    End If
    If myItem = 0 Then GetNearestRow = 0: Exit Function
    GetNearestRow = Evaluate("match(" & myItem & "," & myList(1)(1) & "+0,0)") + 1
End Function

---

not very good with excel and the code is ugly.
please try anyway.

NickWels

Optimized the function, resulting in a significant speed increase

Code:

---

Sub test()
    Dim myList, s(2), a, i&, ii&, t&, myRow&, myItem, x&
    myList = Array(Array("Symbol", ""), Array("Item", ""), Array("Flag", ""))
    Application.DisplayAlerts = False
    For i = 0 To 2
        On Error Resume Next
        myList(i)(1) = Application.InputBox("Select column for " & myList(i)(0), Type:=8).Column
        If t < myList(i)(1) Then t = myList(i)(1)
        If myList(i)(1) = "" Then Exit Sub
        On Error GoTo 0
    Next
    s(0) = InputBox("Enter Symbol"): If s(0) = "" Then Exit Sub
    s(1) = Application.InputBox("Enter Value", Type:=1)
    Application.ScreenUpdating = False
    With [a1].CurrentRegion.Resize(, t).Offset(1)
        a = .Value2
        ReDim b(1 To UBound(a, 1), 1 To 1)
        Do
            s(2) = s(2) + s(1)
            If s(2) > UBound(a, 1) Then Exit Do
            x = GetNearestRow(a, s, myList)
            If x Then b(x, 1) = "x"
        Loop
        .Columns(myList(2)(1)).Value = b
    End With
    MsgBox "done"
    Application.ScreenUpdating = True
End Sub


Function GetNearestRow&(a, s, myList)
    Dim i&
    For i = 0 To s(1) - 1
        If s(2) + i <= UBound(a, 1) Then
            If a(s(2) + i, myList(0)(1)) = s(0) Then GetNearestRow = s(2) + i: Exit For
        End If
        If a(s(2) - i, myList(0)(1)) = s(0) Then GetNearestRow = s(2) - i: Exit For
    Next
End Function

---

Jindon you beauty... this works perfectly and is so fast!
Thank you very much for understanding the request and excelling in a solution, much appreciated :)

Glad it worked and thanks for the feedback.