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, Jul 01 '16 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, Jul 01 '16 at 17:09

score 1 · Answer 1 · answered Jul 01 '16 at 17:56

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 01 '16 at 17:56

Shai Rado

33,032
6
29
51

1

You want the Exit Do inside the if statement or there is no reason to loop as it will stop on the first iteration. – Scott Craner Jul 01 '16 at 17:59
Your **Found** msgbox is being displayed when there is no match and there is no increment to `aCheck_Row` in the loop.. – Jul 01 '16 at 17:59
@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. – Shai Rado Jul 01 '16 at 18:06
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 – phillipsK Jul 01 '16 at 18:11
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. – Jul 01 '16 at 18:12

Excel VBAa IF value is in array Do While Loop

1 Answers1