Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub ReadDataFromCloseFile()
- On Error GoTo ErrHandler
- Application.ScreenUpdating = False
- Dim workbookArr() As Workbook
- Dim totalRows() As Integer
- Dim existedCount As Long
- Dim fileIndex As Long
- 'SHOW USERFORM
- ui.Show
- ' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
- existedCount = ui.ListBox1.ListCount
- ReDim workbookArr(existedCount)
- Set workbookArr(0) = Workbooks.Open(ui.TextBox1.Text, True, False)
- For fileIndex = 1 To existedCount
- Set workbookArr(fileIndex) = Workbooks.Open(ui.ListBox1.List(fileIndex - 1), True, False)
- Next fileIndex
- '==================================================================
- ' GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK.
- ReDim totalRows(existedCount)
- For i = 0 To existedCount
- totalRows(i) = workbookArr(i).Worksheets("Sheet1").Range("A1048576").End(xlUp).Row
- Next i
- ' GIVE EACH ROW UNIQUE ID
- Dim myConcatenateCell As String
- myConcatenateCell = "AA" & "2" 'TODO: VISUALLY WE CHOOSE THIS CELL TO APPLY, NEED TO AUTO FIND IT LATER
- For i = 0 To existedCount
- workbookArr(i).Worksheets("Sheet1").Range(myConcatenateCell & ":AA" & CStr(totalRows(i) + 1)).FormulaR1C1 = "=CONCATENATE(RC[-21],RC[-18])"
- Next i
- ' CLASSIFY EACH TRANSACTION HERE. RETURN 1 IF EXISTED, 0 IF NOT
- Dim myFirstColumn As Long
- Dim myLastColumn As Long
- Dim myColumnIndex As Long
- Dim myFirstRow As Long
- Dim myLastRow As Long
- Dim myVLookupResult As Variant
- Dim myTableArray As Range
- Dim lookUpValue As String
- myFirstColumn = 27 'TODO: FIND SUITABLE COLUMN
- myLastColumn = 27
- myColumnIndex = 1
- myFirstRow = 2
- myLastRow = totalRows(1)
- With workbookArr(1).Worksheets("Sheet1")
- Set myTableArray = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myLastColumn))
- End With
- ' ITERATE EVERY EXISTED FILE
- For i = 1 To existedCount
- With workbookArr(i).Worksheets("Sheet1")
- Set myTableArray = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myLastColumn))
- End With
- For j = 2 To totalRows(0)
- lookUpValue = workbookArr(0).Worksheets("Sheet1").Range("AA" & CStr(j)).Value
- myVLookupResult = Application.VLookup(lookUpValue, myTableArray, myColumnIndex, False)
- If (IsError(myVLookupResult)) Then
- workbookArr(0).Worksheets("Sheet1").Range("AB" & CStr(j)).Value = 0
- Else: workbookArr(0).Worksheets("Sheet1").Range("AB" & CStr(j)).Value = 1
- End If
- Next j
- Next i
- ' TODO: DELETE CODE COLUMN
- '==================================================================
- ' CLOSE THE SOURCE FILE.
- workbookArr(0).Close True ' TRUE - SAVE THE SOURCE FILE.
- Set srcNew = Nothing
- workbookArr(1).Close False ' FALSE - DON'T SAVE THE SOURCE FILE.
- Set srcOld1 = Nothing
- workbookArr(2).Close False ' FALSE - DON'T SAVE THE SOURCE FILE.
- Set srcOld2 = Nothing
- ErrHandler:
- Application.EnableEvents = True
- Application.ScreenUpdating = True
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement