Excel VBAa IF value is in array Do While Loop

Question

Going off of this post I was trying to test if a value in one array was in another and if so to cut the row and move to another sheet called Sheets("Exclusions") But I'm getting a Do without Loop error however I believe I have the correct syntax?

Sheets("Main").Activate

LR = Range("a1000").End(xlUp).Row
LC = 3 'Range("zz1").End(xlToLeft).Column


        cName = "Sec ID"
        cA = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column

         ReDim aCheck(1 To LR, 1 To LC)


                For i = 2 To LR
                        aCheck_Row = aCheck_Row + 1
                            aCheck(aCheck_Row, 1) = cells(i, cA)             'Security 

'''' Does not Work                     
'                            If aCheck(aCheck_Row, 1) = Yet_Another_array(Yet_Another_array_Row, 1) Then
'                            Debug.Print ("Y")
                        Do
                            If IsError(Application.Match(aCheck(aCheck_Row, 1), Yet_Another_array, 0)) Then
                            MsgBox "Found"

                            Dim ASR As Worksheet, LS As Worksheet

                            Set ASR = ActiveWorkbook.Sheets("Main")
                            Set LS = ActiveWorkbook.Sheets("Exclusions")
                             ASR.cells(i, "C").EntireRow.Cut Destination:=LS.Range("A" & LS.Rows.Count).End(xlUp).Offset(1)

                            Exit Do

                        Loop While Not IsEmpty(aCheck)

I'm also struggling trying to figure out the cut and past code from here Excel Macro To Cut Rows And Paste Into Another Worksheet

FULL CODE (It's a lot)

Sub Import_CSV()
Dim WrdArray() As String
Dim line As String
Dim clm As Long
Dim Rw As Long


Application.ScreenUpdating = False

Sheets("Macro").Select
RB_import = Application.cells(21, 4)
'File_Loc = Cells(21, 4)

Set txtstrm = FSO.OpenTextFile(RB_import)
Sheets("RB").Visible = True
Sheets("RB").Activate
Range("A:DA").Select
Selection.ClearContents
Rw = 1
Do Until txtstrm.AtEndOfStream
  line = txtstrm.ReadLine
  clm = 1
  WrdArray() = Split(line, "|")
  For Each wrd In WrdArray()
    ActiveSheet.cells(Rw, clm) = wrd
    clm = clm + 1
  Next wrd
  Rw = Rw + 1
Loop
txtstrm.Close
Rows("1:28").Select
Selection.Delete Shift:=xlUp 'deletes generic header info from .req files
Range("A:DA").Select
Selection.NumberFormat = "@"


    '-----Creates Temp Source to loop through--------------------------------------------------------
        LR = Range("a65000").End(xlUp).Row
        LC = 15
        ReDim Source(1 To LR, 1 To LC)
        Source = Range(cells(1, 1), cells(LR, LC))
        'tempbk.Close SaveAs = False
    '------------------------------------------------------------------------------------------------
Dim a As Range
rbRow = 0

For r = 1 To LR
    rbRow = rbRow + 1
    aRB_Return_Import(rbRow, 1) = Source(r, 1) 'security ID
    aRB_Return_Import(rbRow, 2) = Source(r, 4) 'PX_OPEN
    aRB_Return_Import(rbRow, 3) = Source(r, 5) 'PX_LAST
    aRB_Return_Import(rbRow, 4) = Source(r, 6) 'CHG_PCT_1D
    'aRB_Return_Import(rbRow, 5) = Source(r, 7) 'net rate
'
'  If RB_List.Exists(aRB_Return_Import(Row, 3)) Then
'    TempArray(Row, 18) = Sec_id_dic(TempArray(Row, 3))
'  End If





Next r

'Sheets("RB").Visible = False
'Sheets("RB_Return").Select
Sheets("Recon").Select

'Range("a2:i" & rbRow) = aRB_Return_Import
Range("G2:i" & rbRow) = aRB_Return_Import
'Range("G2") = aRB_Return_Import

'Range("D2").Select
'    Range(Selection, Selection.End(xlDown)).Select
'    Selection.Style = "Percent"
'    Selection.NumberFormat = "0.00%"

LR = Range("a1000").End(xlUp).Row
LC = 30 'Range("zz1").End(xlToLeft).Column


        cName = "Security"
        cA = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
        cName = "Current Price"
        cB = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
        cName = "Prior Price"
        cC = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
        cName = "Change Price (%)"
        cD = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
        cName = "Check"
        cE = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "Price Date"
'        cF = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "Current Price"
'        cG = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "Prior Price"
'        cH = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "Change Price (%)"
'        cI = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "BPS Impact"
'        cJ = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "Source"
'        cK = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column
'        cName = "Source"

        ReDim aRecon(1 To LR, 1 To LC)
        ReDim Yet_Another_array(1 To 200, 1 To 20)


                For i = 2 To LR
                        aRecon_Row = aRecon_Row + 1
                            aRecon(aRecon_Row, 1) = CStr(cells(i, cA))      'Security 'previously was fund #
                            aRecon(aRecon_Row, 2) = cells(i, cB)            'Current Price
                            aRecon(aRecon_Row, 3) = cells(i, cC)            'Prior Price
                            aRecon(aRecon_Row, 4) = cells(i, cD)            'Change Price (%)
                             On Error GoTo ErrorHandler
                            If (aRecon(aRecon_Row, 2) - aRecon(aRecon_Row, 3)) / aRecon(aRecon_Row, 3) <> 2 Then 'aRB_Return_Import(rbRow, 4) Then
                                       aRecon(aRecon_Row, 5) = "Pass"            'CHeck Pass or Fail
                                       Yet_Another_array_Row = Yet_Another_array_Row + 1
                                       Yet_Another_array(Yet_Another_array_Row, 1) = aRecon(aRecon_Row, 1)
                            Else
ErrorHandler:
                                       aRecon(aRecon_Row, 5) = "Fail"            'CHeck Pass or Fail
                            End If


'                            aRecon(aRecon_Row, 6) = Cells(i, cF)            'Price Date
'                            aRecon(aRecon_Row, 7) = Cells(i, cG).Value      'Current Price
'                            'Debug.Print aRecon_Row
'                            aRecon(aRecon_Row, 8) = Cells(i, cH).Value      'Prior Price
'                            aRecon(aRecon_Row, 9) = Cells(i, cI)            '
'                            aRecon(aRecon_Row, 10) = Cells(i, cJ)           'BPS Impact
'                            aRecon(aRecon_Row, 11) = Cells(i, cK)           'Source
'                            aRecon(aRecon_Row, 12) = Cells(i, cL)           'SSIMS - Comment

                Next i

Set Destination = Range("L2")
Destination.Resize(UBound(aRecon, 1), UBound(aRecon, 2)).Value = aRecon

Set Destination = Range("T2")
Destination.Resize(UBound(Yet_Another_array, 1), UBound(Yet_Another_array, 2)).Value = Yet_Another_array

Sheets("Main").Activate

LR = Range("a1000").End(xlUp).Row
LC = 3 'Range("zz1").End(xlToLeft).Column


        cName = "Sec ID"
        cA = ActiveSheet.Rows.Find(What:=UCase(cName), LookAt:=xlWhole, SearchDirection:=xlNext).Column

         ReDim aCheck(1 To LR, 1 To LC)


                For i = 2 To LR
                        aCheck_Row = aCheck_Row + 1
                            aCheck(aCheck_Row, 1) = cells(i, cA)      'Security 'previously was fund #
                            'aCheck(aCheck_Row, 2) = Cells(i, cB)            'Current Price
                            'aCheck(aCheck_Row, 3) = Cells(i, cC)            'Prior Price

'                            If aCheck(aCheck_Row, 1) = Yet_Another_array(Yet_Another_array_Row, 1) Then
'                            Debug.Print ("Y")
'                            End If

                            Do
                                If IsError(Application.Match(aCheck(aCheck_Row, 1), Yet_Another_array, 0)) Then
                                MsgBox "Found"

                                Dim ASR As Worksheet, LS As Worksheet

                                Set ASR = ActiveWorkbook.Sheets("Main")
                                Set LS = ActiveWorkbook.Sheets("Exclusions")
                                 ASR.cells(i, "C").EntireRow.Cut Destination:=LS.Range("A" & LS.Rows.Count).End(xlUp).Offset(1)

                                Exit Do

                            Loop While Not IsEmpty(aCheck)



                Next i




Application.ScreenUpdating = True

End Sub

You didn't post your entire code, do you also have Next i at the end of the For i = 2 to LR loop ? — Shai Rado
– Shai Rado, Commented Jul 1, 2016 at 17:02
@ShaiRado Apologies, I thought I did, the full procedure is lengthy but the last two arrays sum up my question. Thank you — phillipsK
– phillipsK, Commented Jul 1, 2016 at 17:09

Shai Rado · Accepted Answer · 2016-07-01 17:56:10Z

1

I am not sure where are you getting error (which line), but I would take the worksheet declaration and Setting outside the loop (to reduce code run-time).

ReDim aCheck(1 To LR, 1 To LC)

Dim ASR As Worksheet, LS As Worksheet

Set ASR = ActiveWorkbook.Sheets("Main")
Set LS = ActiveWorkbook.Sheets("Exclusions")

For i = 2 To LR
    aCheck_Row = aCheck_Row + 1
    aCheck(aCheck_Row, 1) = Cells(i, cA)      'Security 'previously was fund #
    'aCheck(aCheck_Row, 2) = Cells(i, cB)     'Current Price
    'aCheck(aCheck_Row, 3) = Cells(i, cC)     'Prior Price

    '                            If aCheck(aCheck_Row, 1) = Yet_Another_array(Yet_Another_array_Row, 1) Then
    '                            Debug.Print ("Y")
    '                            End If

    Do
        If IsError(Application.Match(aCheck(aCheck_Row, 1), Yet_Another_array, 0)) Then
            MsgBox "Found"
            ASR.Cells(i, "C").EntireRow.Cut Destination:=LS.Range("A" & LS.Rows.count).End(xlUp).Offset(1)
        End If
        Exit Do

    Loop While Not IsEmpty(aCheck)

Next i

answered Jul 1, 2016 at 17:56

Shai Rado

33.7k7 gold badges32 silver badges55 bronze badges

Sign up to request clarification or add additional context in comments.

5 Comments

Scott Craner Over a year ago

You want the Exit Do inside the if statement or there is no reason to loop as it will stop on the first iteration.

user4039065 Over a year ago

Your Found msgbox is being displayed when there is no match and there is no increment to aCheck_Row in the loop..

Shai Rado Over a year ago

@Jeeped since the code didn't have Else or End If I wasn't sure what goes where, I wasn't sure what the logic of the internal loop was, I just wanted to remove the errors that prevented the code from running, and to take out the Worksheet declarations and settings.

phillipsK Over a year ago

Thanks for the answer I need a conditional before cutting and removing the row as the code you and I have are cutting all rows, I only want to cut a row if it matches a value within the Yet_another_array array

user4039065 Over a year ago

Perhaps but what you have essentially provided is an infinite loop if the Exit Do is moved inside the If ... End If and a match is found on the first pass.

Collectives™ on Stack Overflow

Excel VBAa IF value is in array Do While Loop

1 Answer 1

5 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

5 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related