SHARE
TWEET

Untitled

a guest Aug 20th, 2019 93 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. 'TODO LEFT:
  2. 'INPUT DATA NEEDED:
  3. '1.NUMBER OF WORKBOOK
  4. '2.WORKBOOKS'S DIRECTORY
  5. '
  6. '+
  7.  
  8. Sub ReadDataFromCloseFile()
  9.  
  10.     On Error GoTo ErrHandler
  11.     Application.ScreenUpdating = False
  12.    
  13.     ' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
  14.     ' TODO: WE MANUALLY OPEN EACH FILE, NEED GET DIRECTORY AND NUMBER OF FILE
  15.     Dim workbookArr(2)
  16.    
  17.     Set workbookArr(0) = Workbooks.Open("/Users/toannd/Documents/Transaction_New.xlsx", True, False)
  18.     Set workbookArr(1) = Workbooks.Open("/Users/toannd/Documents/Transaction_Fragment_1.xlsx", True, False)
  19.     Set workbookArr(2) = Workbooks.Open("/Users/toannd/Documents/Transaction_Fragment_2.xlsx", True, False)
  20.    
  21.     '==================================================================
  22.    
  23.     ' GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK.
  24.     Dim totalRowsNew As Integer
  25.     Dim totalRowsOld1 As Integer
  26.     Dim totalRowsOld2 As Integer
  27.    
  28.     totalRowsNew = workbookArr(0).Worksheets("Sheet1").Range("A1048576").End(xlUp).Row
  29.     totalRowsOld1 = workbookArr(1).Worksheets("Sheet1").Range("A1048576").End(xlUp).Row
  30.     totalRowsOld2 = workbookArr(2).Worksheets("Sheet1").Range("A1048576").End(xlUp).Row
  31.    
  32.     'Range("A23").Value = srcNew.Worksheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
  33.    
  34.     ' Concentrate product's code and customer's code
  35.    
  36.     Dim myConcatenateCell As String
  37.    
  38.     myConcatenateCell = "AA" & "2" 'TODO: VISUALLY WE CHOOSE THIS CELL TO APPLY, NEED TO AUTO FIND IT LATER
  39.    
  40.     'TODO: ITERATION
  41.     workbookArr(0).Worksheets("Sheet1").Range(myConcatenateCell & ":AA" & CStr(totalRowsNew + 1)).FormulaR1C1 = "=CONCATENATE(RC[-21],RC[-18])"
  42.     workbookArr(1).Worksheets("Sheet1").Range(myConcatenateCell & ":AA" & CStr(totalRowsOld1 + 1)).FormulaR1C1 = "=CONCATENATE(RC[-21],RC[-18])"
  43.     workbookArr(2).Worksheets("Sheet1").Range(myConcatenateCell & ":AA" & CStr(totalRowsOld2 + 1)).FormulaR1C1 = "=CONCATENATE(RC[-21],RC[-18])"
  44.    
  45.     ' Look up value, return 1 if existed same value, otherwise 0
  46.    
  47.     Dim myFirstColumn As Long
  48.     Dim myLastColumn As Long
  49.     Dim myColumnIndex As Long
  50.     Dim myFirstRow As Long
  51.     Dim myLastRow As Long
  52.     Dim myVLookupResult As Variant
  53.     Dim myTableArray As Range
  54.     Dim lookUpValue As String
  55.    
  56.     myFirstColumn = 27 'TODO: FIND SUITABLE COLUMN
  57.     myLastColumn = 27
  58.     myColumnIndex = 1
  59.     myFirstRow = 2
  60.     myLastRow = totalRowsOld1
  61.    
  62.     With workbookArr(1).Worksheets("Sheet1")
  63.         Set myTableArray = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myLastColumn))
  64.     End With
  65.    
  66.     ' Iterate to check every (just filled in) transaction
  67.     'TODO: NEED ITERATION EVERY FILE
  68.    
  69.     For i = 1 To 2
  70.         With workbookArr(i).Worksheets("Sheet1")
  71.             Set myTableArray = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myLastColumn))
  72.         End With
  73.        
  74.         For j = 2 To totalRowsNew
  75.             lookUpValue = workbookArr(0).Worksheets("Sheet1").Range("AA" & CStr(j)).Value
  76.             myVLookupResult = Application.VLookup(lookUpValue, myTableArray, myColumnIndex, False)
  77.             If (IsError(myVLookupResult)) Then
  78.                 workbookArr(0).Worksheets("Sheet1").Range("AB" & CStr(j)).Value = 0
  79.             Else: workbookArr(0).Worksheets("Sheet1").Range("AB" & CStr(j)).Value = 1
  80.             End If
  81.         Next j
  82.     Next i
  83.      
  84.     '==================================================================
  85.    
  86.     ' CLOSE THE SOURCE FILE.
  87.     workbookArr(0).Close True             ' TRUE - SAVE THE SOURCE FILE.
  88.     Set srcNew = Nothing
  89.    
  90.     workbookArr(1).Close False             ' FALSE - DON'T SAVE THE SOURCE FILE.
  91.     Set srcOld1 = Nothing
  92.    
  93.     srcOld2.Close False             ' FALSE - DON'T SAVE THE SOURCE FILE.
  94.     Set srcOld2 = Nothing
  95.    
  96. ErrHandler:
  97.     Application.EnableEvents = True
  98.     Application.ScreenUpdating = True
  99. 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