SHARE
TWEET

Untitled

a guest Aug 21st, 2019 66 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.  
  2. Sub ReadDataFromCloseFile()
  3.  
  4.     On Error GoTo ErrHandler
  5.     Application.ScreenUpdating = False
  6.    
  7.     Dim workbookArr() As Workbook
  8.     Dim totalRows() As Integer
  9.     Dim existedCount As Long
  10.     Dim fileIndex As Long
  11.    
  12.     'SHOW USERFORM
  13.     ui.Show
  14.    
  15.     ' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
  16.     existedCount = ui.ListBox1.ListCount
  17.     ReDim workbookArr(existedCount)
  18.    
  19.     Set workbookArr(0) = Workbooks.Open(ui.TextBox1.Text, True, False)
  20.     For fileIndex = 1 To existedCount
  21.         Set workbookArr(fileIndex) = Workbooks.Open(ui.ListBox1.List(fileIndex - 1), True, False)
  22.     Next fileIndex
  23.  
  24.     '==================================================================
  25.    
  26.     ' GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK.
  27.     ReDim totalRows(existedCount)
  28.  
  29.     For i = 0 To existedCount
  30.         totalRows(i) = workbookArr(i).Worksheets("Sheet1").Range("A1048576").End(xlUp).Row
  31.     Next i
  32.    
  33.     ' GIVE EACH ROW UNIQUE ID
  34.     Dim myConcatenateCell As String
  35.     myConcatenateCell = "AA" & "2" 'TODO: VISUALLY WE CHOOSE THIS CELL TO APPLY, NEED TO AUTO FIND IT LATER
  36.    
  37.     For i = 0 To existedCount
  38.         workbookArr(i).Worksheets("Sheet1").Range(myConcatenateCell & ":AA" & CStr(totalRows(i) + 1)).FormulaR1C1 = "=CONCATENATE(RC[-21],RC[-18])"
  39.     Next i
  40.    
  41.     ' CLASSIFY EACH TRANSACTION HERE. RETURN 1 IF EXISTED, 0 IF NOT
  42.     Dim myFirstColumn As Long
  43.     Dim myLastColumn As Long
  44.     Dim myColumnIndex As Long
  45.     Dim myFirstRow As Long
  46.     Dim myLastRow As Long
  47.     Dim myVLookupResult As Variant
  48.     Dim myTableArray As Range
  49.     Dim lookUpValue As String
  50.    
  51.     myFirstColumn = 27 'TODO: FIND SUITABLE COLUMN
  52.     myLastColumn = 27
  53.     myColumnIndex = 1
  54.     myFirstRow = 2
  55.     myLastRow = totalRows(1)
  56.    
  57.     With workbookArr(1).Worksheets("Sheet1")
  58.         Set myTableArray = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myLastColumn))
  59.     End With
  60.    
  61.     ' ITERATE EVERY EXISTED FILE
  62.     For i = 1 To existedCount
  63.         With workbookArr(i).Worksheets("Sheet1")
  64.             Set myTableArray = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myLastColumn))
  65.         End With
  66.        
  67.         For j = 2 To totalRows(0)
  68.             lookUpValue = workbookArr(0).Worksheets("Sheet1").Range("AA" & CStr(j)).Value
  69.             myVLookupResult = Application.VLookup(lookUpValue, myTableArray, myColumnIndex, False)
  70.             If (IsError(myVLookupResult)) Then
  71.                 workbookArr(0).Worksheets("Sheet1").Range("AB" & CStr(j)).Value = 0
  72.             Else: workbookArr(0).Worksheets("Sheet1").Range("AB" & CStr(j)).Value = 1
  73.             End If
  74.         Next j
  75.     Next i
  76.      
  77.     ' TODO: DELETE CODE COLUMN
  78.    
  79.     '==================================================================
  80.    
  81.     ' CLOSE THE SOURCE FILE.
  82.     workbookArr(0).Close True             ' TRUE - SAVE THE SOURCE FILE.
  83.     Set srcNew = Nothing
  84.    
  85.     workbookArr(1).Close False             ' FALSE - DON'T SAVE THE SOURCE FILE.
  86.     Set srcOld1 = Nothing
  87.    
  88.     workbookArr(2).Close False             ' FALSE - DON'T SAVE THE SOURCE FILE.
  89.     Set srcOld2 = Nothing
  90.    
  91. ErrHandler:
  92.     Application.EnableEvents = True
  93.     Application.ScreenUpdating = True
  94.    
  95. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top