Hi I running this code below it actually overrides data and also highlights yellow if there is an override after a file is uploaded.
I need to add in here somewhere "if there is a data change like a mismatch from previous upload In Columns H,L,P,T,X,AA,AD to highlight yellow or any color.
Right now I have no overrides for those columns or nothing. So I just need a highlight if there is a data change in any of those columns after any upload.
Any help here?
I need to add in here somewhere "if there is a data change like a mismatch from previous upload In Columns H,L,P,T,X,AA,AD to highlight yellow or any color.
Right now I have no overrides for those columns or nothing. So I just need a highlight if there is a data change in any of those columns after any upload.
Any help here?
Code:
Private Sub btnUploadData_Click()
Dim wbmf As Workbook
Dim wsMF As Worksheet
Set wbmf = Workbooks("Master Time Sheet.xlsm")
Dim wbTF As Workbook
Dim strFileToOpen As String
Dim FleERow As Integer
Dim Template As String, Msg As String
Dim Desc As String
Dim FileRow, FleRow As Integer
Dim Ovrwrtcol As Long
Set wsMF = wbmf.Sheets("Tool")
FleERow = wsMF.Range("A" & Rows.count).End(xlUp).Row
If FleERow = 14 Then
MsgBox ("There are no Files to Upload")
Exit Sub
End If
If ckboxClear.Value = False Then
wbmf.Sheets("UnMatchData").Range("A4:AH" & wbmf.Sheets("UnMatchData").Range("A" & Rows.count).End(xlUp).Row + 3).Clear
End If
For FleRow = 15 To FleERow
strFileToOpen = wsMF.Range("B" & FleRow).Text
If strFileToOpen <> "" Then
Dim IsOpened As Boolean
Dim FileShrtName As String
Dim Idx As Integer
IsOpened = False
For Idx = 1 To Workbooks.count
If Workbooks(Idx).FullName = strFileToOpen Then
IsOpened = True
FileShrtName = Workbooks(Idx).Name
End If
Next Idx
If IsOpened Then
Set wbTF = Workbooks(FileShrtName)
Else
' If VBA.Len(VBA.Dir(strFileToOpen)) > 0 Then
Application.DisplayAlerts = False
Workbooks.Open (strFileToOpen)
Set wbTF = Workbooks(Workbooks.count)
End If
End If
If wsMF.Range("F" & FleRow).Text = "" Then
MsgBox ("Please select WeekEnding Date")
Exit Sub
End If
Ovrwrtcol = Me.Shapes("Rectangle 7").Fill.ForeColor.RGB
Template = wsMF.Range("D" & FleRow).Text
If Template = "Template 1" Then
Msg = Temp1(wbTF, wsMF.Range("C" & FleRow).Text, Ovrwrtcol)
ElseIf Template = "Template 2" Then
Msg = Temp2(wbTF, wsMF.Range("C" & FleRow).Text, Ovrwrtcol)
End If
If IsOpened <> True Then
Workbooks(Workbooks(Workbooks.count).Name).Close
Application.DisplayAlerts = True
End If
MsgBox (Msg)
Next
Set wbmf = Nothing
Set wsMF = Nothing
Set wbTF = Nothing
End Sub
Code:
Sub PasteData(ByRef WeekData() As ShiftData, ByRef MFRow As Integer, ByVal ELocal As String, ByVal ERate As String, ByVal Notes As String)
Set wbmf = Workbooks("Master Time Sheet.xlsm")
Set wsMF = wbmf.Sheets("Data")
Dim MFCol As Integer
Dim PrevData(26) As String
Dim Idx As Integer
If VBA.LCase(wsMF.Cells(MFRow, 3).Text) = "office" Then
Exit Sub
End If
MFCol = 3
wsMF.Cells(MFRow, MFCol).Value = ELocal
MFCol = MFCol + 1
wsMF.Cells(MFRow, MFCol).Value = ERate
MFCol = MFCol + 1
Idx = 0
For MFCol = 5 To 30
PrevData(Idx) = wsMF.Cells(MFRow, MFCol).Text
Idx = Idx + 1
Next
MFCol = 5
For Idx = 0 To 6
If Idx = 5 Or Idx = 6 Then GoTo OT2
If WeekData(Idx).ST <> -1 Then
wsMF.Cells(MFRow, MFCol).Value = WeekData(Idx).ST
End If
MFCol = MFCol + 1
OT2:
If WeekData(Idx).OT <> -1 Then
wsMF.Cells(MFRow, MFCol).Value = WeekData(Idx).OT
End If
MFCol = MFCol + 1
If WeekData(Idx).DT <> -1 Then
wsMF.Cells(MFRow, MFCol).Value = WeekData(Idx).DT
End If
MFCol = MFCol + 1
If ShtTmp <> 2 Then
If wsMF.Cells(MFRow, MFCol).Value = "" Then
wsMF.Cells(MFRow, MFCol).Value = WeekData(Idx).job
ElseIf wsMF.Cells(MFRow, MFCol).Value <> WeekData(Idx).job Then
wsMF.Cells(MFRow, MFCol).Value = wsMF.Cells(MFRow, MFCol).Value
End If
End If
MFCol = MFCol + 1
Next
MFCol = MFCol + 3
wsMF.Cells(MFRow, MFCol).Value = Notes
Idx = 0
For MFCol = 5 To 30
If PrevData(Idx) <> "" Then
If PrevData(Idx) <> wsMF.Cells(MFRow, MFCol).Text Then
wsMF.Cells(MFRow, MFCol).Interior.Color = Ovrwrtcol
End If
End If
Idx = Idx + 1
Next
End Sub