Posts by KjBox

Sub UpdateResults()
    Dim x, y, z, i As Long, ii As Long
    x = [Table1]: y = [Table1[ID]]: z = [Table2]
    
    For i = 1 To UBound(z, 1)
        If Not IsError(Application.Match(z(i, 1), y, 0)) Then
            ii = Application.Match(z(i, 1), y, 0)
            If x(ii, 5) = z(i, 2) And x(ii, 6) = z(i, 3) Then
                x(ii, 7) = z(i, 4)
            End If
        End If
    Next
    [Table1] = x
    Sheet1.Activate
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sMsg1 As String, sMsg2 As String, sMsg3 As String, s As String
    sMsg1 = "Loan Creation date is "
    sMsg2 = "Savings Entry date is "
    sMsg3 = ". All Date will be ""dd/mm/yyyy"""
    
    If Target.Count > 1 Then Exit Sub
    If Target.Row > 8 And Target.Column = 5 Then
        If Cells(Target.Row, 2) = "Debit" Then
            s = InputBox("Date of Loan Creation", "Loan Creation")
            If Len(s) Then
                If IsDate(s) Then
                    Cells(Target.Row, 43) = Format(CDate(s), "dd/mm/yyyy")
                    MsgBox sMsg1 & Format(CDate(s), "dd/mm/yyyy")
                End If
            End If
        ElseIf Cells(Target.Row, 2) = "Credit or Other" Then
            s = InputBox("Date of Savings Entry Creation", "Saving Entry Creation")
            If Len(s) Then
                If IsDate(s) Then
                    Cells(Target.Row, 27) = Format(CDate(s), "dd/mm/yyyy")
                    MsgBox sMsg2 & Format(CDate(s), "dd/mm/yyyy") & sMsg3
                End If
            End If
        End If
    End If
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sMsg1 As String, sMsg2 As String, sMsg3 As String, s As String
    sMsg1 = "Loan Creation date is "
    sMsg2 = "Savings Entry date is "
    sMsg3 = ". All Date will be ""dd/mm/yyyy"""
    
    If Target.Count > 1 Then Exit Sub
    If Target.Row > 8 And Target.Column = 5 Then
        If Cells(Target.Row, 2) = "Debit" Then
            s = InputBox("Date of Loan Creation", "Loan Creation")
            If Len(s) Then
                If IsDate(s) Then
                    Cells(Target.Row, 43) = Format(CDate(s), "dd/mm/yyyy")
                    MsgBox sMsg1 & Format(CDate(s), "dd/mm/yyyy")
                End If
            End If
        ElseIf Len(Cells(Target.Row, 2)) Then
            s = InputBox("Date of Savings Entry Creation", "Saving Entry Creation")
            If Len(s) Then
                If IsDate(s) Then
                    Cells(Target.Row, 27) = Format(CDate(s), "dd/mm/yyyy")
                    MsgBox sMsg2 & Format(CDate(s), "dd/mm/yyyy") & sMsg3
                End If
            End If
        End If
    End If
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sMsg1 As String, sMsg2 As String, sMsg3 As String, s As String
    sMsg1 = "Loan Creation date is "
    sMsg2 = "Savings Entry date is "
    sMsg3 = ". All Date will be ""dd/mm/yyyy"""
    
    If Target.Count > 1 Then Exit Sub
    If Target.Row > 8 And Target.Column = 5 Then
        If Cells(Target.Row, 2) = "Debit" Then
            s = InputBox("Date of Loan Creation", "Loan Creation")
            If Len(s) Then
                If IsDate(s) Then
                    Cells(Target.Row, 43) = Format(CDate(s), "dd/mm/yyyy")
                    MsgBox sMsg1 & Format(CDate(s), "dd/mm/yyyy")
                End If
            End If
        Else
            s = InputBox("Date of Savings Entry Creation", "Saving Entry Creation")
            If Len(s) Then
                If IsDate(s) Then
                    Cells(Target.Row, 27) = Format(CDate(s), "dd/mm/yyyy")
                    MsgBox sMsg2 & Format(CDate(s), "dd/mm/yyyy") & sMsg3
                End If
            End If
        End If
    End If
    
End Sub

Sub CombineTextAndNumber()
    Dim x, y, i As Long, ii As Long, oDic As Object
    Set oDic = CreateObject("scripting.dictionary")
    
    With ActiveSheet
        x = .Cells(1).CurrentRegion
        For i = UBound(x, 1) To 1 Step -1
            If IsNumeric(x(i, 1)) Then
                ii = i - 1
                Do Until IsNumeric(x(ii, 1))
                    oDic.Add oDic.Count, x(i, 1) & " " & x(ii, 1)
                    ii = ii - 1
                    If ii < 1 Then Exit For
                Loop
                i = ii + 1
            End If
        Next
        ReDim y(1 To oDic.Count, 1 To 2)
        ii = 0
        For i = oDic.Count - 1 To 0 Step -1
            ii = i + 1
            y(ii, 1) = Split(oDic(i))(0)
            y(ii, 2) = Split(oDic(i))(1)
        Next
        With .[c1]
            .Resize(100000, 2).Clear
            .Resize(UBound(y), 2) = y
            .Resize(UBound(y), 2).HorizontalAlignment = -4108
        End With
    End With
    
End Sub