phillipsK
phillipsK

Reputation: 1516

Excel VBAa IF value is in array Do While Loop

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

Upvotes: 1

Views: 581

Answers (1)

Shai Rado
Shai Rado

Reputation: 33682

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

Upvotes: 1

Related Questions