Snasui Excel Forum

Code: Select all

Sub Import_StartDate()
    Dim wk As Workbook, path As String, Fname As String
    Dim Rng As Range, Dn As Range, Cel As Range
    Dim Ng As Range, Fdt As Range
    Dim Dt As Range, SRn As String
    Dim Vdt As String, FileName As String
    Dim ThisWb As String, Ndata As Double
    Dim i As Long, j As Long
    
    ThisWb = ThisWorkbook.Name
    
    path = "\\op023\Data Center\OPERATION DEPARTMENT\4- CENTRALIZED OPERATION UNIT\4- Restructure Loan in 2020\Schedule Before and After\"
    
    Set Rng = RST1.Range(Range("AD3"), Range("AD" & Rows.Count).End(xlUp))
    
    For Each Dn In Rng
        Fname = Dn & ".xlsx"
        FileName = VBA.FileSystem.Dir(path & Fname)
        If FileName = VBA.Constants.vbNullString Then
            Dn.Offset(0, 3) = "File not found"
        Else
            Set wk = Workbooks.Open(path & Fname)
            Ndata = Range("K" & Rows.Count).End(xlUp).Row
            If Ndata < 3 Then
                Dn.Offset(0, 3) = "No DATA"
                wk.Close SaveChanges:=False
            Else
                Set Cel = Range(Range("K1"), Range("K" & Ndata))
                j = 0
                For i = Cel.Rows.Count To 1 Step -1
                    If Cel(i).Offset(0, 3).Value = 0 And Cel(i).Offset(0, 4) > 0 Then
                        Dn.Offset(0, 3).Value = Cel(i).Offset(1, 0).Value
                        j = j + 1
                        wk.Close False
                        Exit For
                    End If
                Next i
            End If
        End If
        If j = 0 Then
            Dn.Offset(0, 3) = "No DATA"
        End If

        ThisWorkbook.Activate
    Next Dn
    Call MsgBox("Transtion Completed !!!", vbInformation)
End Sub

Code: Select all

Sub Checking ()
Dim ThisCell1 As Range
Dim ThisCell2 As Range
    For Each ThisCell1 In Range("AG3:AG9999")
    'This is the range of cells to check
        For Each ThisCell2 In Range("U3:U9999")
        'This is the range of cells to compare
            If ThisCell1.Value = ThisCell2.Value Then
                ThisCell1.Offset(, 3).Value = "TRUE"
                Exit For
                End If
            Next ThisCell2
        Next ThisCell1