Posts by Luke M

Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rngTrigger As Range
        
        'What cell are we watching?
        Set rngTrigger = Range("A2")
        
        'Did user change it?
        If Intersect(Target, rngTrigger) Is Nothing Then Exit Sub
        
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        
        Select Case UCase(rngTrigger.Value)
            'What are the 8 names, al in upper case?
            Case "ADAM", "BOB", "CHARLIE", "DAN", "EVAN", "FRANK", "SUE", "JOE"
                Call MyMacro
                Range("E9").Value = "Success!"
            Case Else
                'Do nothing?
        End Select
        
        Application.EnableEvents = True
        Application.ScreenUpdating = True
                
    End Sub

Dim MyPath As String
Dim DestPath As String
Dim MyFile As String
Dim MyExt As String
Dim wb As Workbook
Dim NewFile As String
Dim strCheck As String
Dim i As Long
Dim strTemp As String




MyPath = "C:\Users\Owner\Dropbox\Accounts Miqlat\"
DestPath = "C:\Users\Owner\Dropbox\Accounts Miqlat\Imported\" 'Destination to move completed file too
MyExt = "*.xlsx"
MyFile = Dir(MyPath & MyExt)


'Check if file exists already
strTemp = MyFile
strCheck = Dir(DestPath & MyFile)
Do Until strCheck = ""
    i = i + 1
    strTemp = Replace(MyFile, Mid(MyExt, 2), "(" & i & ")" & Mid(MyExt, 2))
    strCheck = Dir(DestPath & strTemp)
Loop
FileCopy MyPath & MyFile, DestPath & strTemp 'copy file to new location

Private Sub Worksheet_Activate()


    Dim wSheet As Worksheet, l As Long


    Application.ScreenUpdating = False


    Me.Move Before:=Sheets(1)
    l = 1


    With Me
        .Columns(1).ClearContents
        .Cells(1, 1) = "INDEX"
        .Cells(1, 1).Name = "Index"
        .Cells(1, 1).Font.Bold = 1
    End With


    For Each wSheet In Worksheets
        If wSheet.Name <> Me.Name Then
            l = l + 1
            With wSheet
                ' Uncomment for the first time then comment again
                ' .Rows("1:1").Insert Shift:=xlUp
                ' .Rows("1:1").Clear
                .Range("A1").Name = "Start_" & .Index
                .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Back to Index"
                .Range("A1").Font.ColorIndex = xlAutomatic
                Me.Hyperlinks.Add Anchor:=Me.Cells(l, 1), Address:="", _
                    SubAddress:="Start_" & .Index, TextToDisplay:=wSheet.Name
                'Don't color cell if tab isn't colored
                If wSheet.Tab.Color Then
                    Me.Cells(l, 1).Interior.Color = wSheet.Tab.Color
                Else
                    Me.Cells(l, 1).Interior.Color = xlNone
                End If
            End With
        End If
        Me.Columns(1).AutoFit
    Next wSheet


    Application.ScreenUpdating = True


End Sub

Sub PullValues()
    Dim vRowCounter As Long
    Dim vRowStart As Long
    Dim vRowEnd As Long
    Dim vRowEndofRange As Long
    Dim vRowStartofRange As Long
    Dim vTotalRows As Long
    Dim wsOp As Worksheet
    Dim wsTarget As Worksheet
    
    Application.ScreenUpdating = False
     
    vRowStart = Worksheets("Start Macro").Range("C6").Value
    vRowEnd = Worksheets("Start Macro").Range("C8").Value
     
    Set wsTarget = Worksheets("Target")
    Set wsOp = Worksheets("Op Facility Augmentation")
     
    vRowStartofRange = vRowStart
    vTotalRows = vRowEnd - vRowStart + 1
     
    With wsTarget
        For vRowCounter = 1 To vTotalRows Step 50
            vRowEndofRange = vRowStartofRange + 49
             
            wsOp.Range("C14").Resize(50, 1).Value = .Range(.Cells(vRowStartofRange, 5), .Cells(vRowEndofRange, 5)).Value
            wsOp.Range("E14").Resize(50, 1).Value = .Range(.Cells(vRowStartofRange, 7), .Cells(vRowEndofRange, 7)).Value
             
             
            .Range(.Cells(vRowStartofRange, 8), .Cells(vRowEndofRange, 8)).Value = wsOp.Range("F14").Resize(50, 1).Value
            .Range(.Cells(vRowStartofRange, 9), .Cells(vRowEndofRange, 9)).Value = wsOp.Range("H14").Resize(50, 1).Value
             
            vRowStartofRange = vRowStartofRange + 50
        Next vRowCounter
    
     
        .Range(.Cells(vRowStart, 10), .Cells(vRowEnd, 10)).Value = wsOp.Range("D5").Value
        .Range(.Cells(vRowStart, 12), .Cells(vRowEnd, 12)).Value = wsOp.Range("F5").Value
        .Range(.Cells(vRowStart, 13), .Cells(vRowEnd, 13)).Value = wsOp.Range("C11").Value
     
        If wsOp.Range("J6").Value = 2 Then
            .Range(.Cells(vRowStart, 11), .Cells(vRowEnd, 11)) = "Yes"
        ElseIf wsOp.Range("J6").Value = 3 Then
            .Range(.Cells(vRowStart, 11), .Cells(vRowEnd, 11)) = "No"
        End If
         
        .Range("H:H").NumberFormat = "General"
    End With
    
    Application.ScreenUpdating = True
     
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngFirst As Range
    Dim rngSec As Range
    Dim rngThird As Range
    Dim myRow As Long
    Dim c As Range
    
    'Where are the columns of interest?
    'Call-out entire columns here
    Set rngFirst = Range("A:A")
    Set rngSec = Range("B:B")
    Set rngThird = Range("C:C")
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    'Loop over target, in case multiple cells changed
    For Each c In Target.Cells
        'Did user change one of our cells?
        If Intersect(c, rngFirst) Is Nothing And Intersect(c, rngSec) Is Nothing Then
            'Do nothing
        Else
            myRow = c.Row
            
            'Compare the values, decide what to do
            If rngFirst.Cells(myRow).Value <> rngSec.Cells(myRow).Value Then
                rngThird.Cells(myRow).Value = Now
            Else
                rngThird.Cells(myRow).ClearContents
            End If
        End If
    Next c
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
     
End Sub