Reputation: 1516
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
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