Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.
2) If the unique identifier exist in sheet Orbit Dump but DOES not exist in sheet Checksheets-All then
Add the item in Col A of sheet Checksheets-All and put today's date in Col Y
3) When point 2) happens we should:
Copy the entire row of the specific Unique identifier into Checksheets-All and not simply the Col A like all columns.
COMMENTS:
if point 3) is correct then what happens here you have different columns in Orbit Dump than in Checksheets-All which one is which ?? You need to provide a clear match col to col.
If it is the case prefer this to be object of a new question as it would entitle a different approach. If not please clarify.
Chechsheets-ALL needs to be updated with information from "Orbit", "MC Tracker Data" according to the mapping.
Sub DailyUpdate()
Dim WSC As Worksheet
Dim WSD As Worksheet
Dim MaxRowC As Long, MaxRowD As Long, I As Long
Dim MinRowC As Long, MinRowD As Long
Dim CRow As Long, DRow As Long
Dim cCell As Range
'---> Disable Events
With Application
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
'---> Set Variables
Set WSC = Sheets("Checksheets-ALL")
MaxRowC = WSC.Range("A" & WSC.Rows.Count).End(xlUp).Row
MinRowC = 9
Set WSD = Sheets("Orbit Dump")
MaxRowD = WSD.Range("A" & WSD.Rows.Count).End(xlUp).Row
MinRowD = 2
'---> 1) If the unique identifier exist in both Checksheets-All and Orbit Dump then:
' a) Put "Completed" in Col X in sheet Checksheets-All
' b) Put today's date in Col U of sheet Orbit Dump.
'---> a) Put "Completed" in Col X in sheet Checksheets-All
' Create Formula to find items in Checksheets-ALL and in Orbit Dump
' =IF(ISERROR(VLOOKUP(A2,Orbit Dump!A:A,1)),"",A2)
WSC.Range("ZZ" & MinRowC & ":ZZ" & MaxRowC).Formula = "=IF(ISERROR(VLOOKUP(A" & MinRowC & ",'Orbit Dump'!A:A,1)),"""",A" & MinRowC & ")"
WSC.Range("ZZ" & MinRowC & ":ZZ" & MaxRowC).Copy
WSC.Range("ZZ" & MinRowC).PasteSpecial xlPasteValues
WSC.Range("A" & MinRowC & ":ZZ" & MaxRowC).Sort Key1:=WSC.Range("ZZ" & MinRowC), order1:=xlDescending, Header:=xlNo
If WSC.Range("ZZ" & MinRowC) <> "" Then
Set cCell = WSC.Range("ZZ" & MinRowC & ":ZZ" & WSC.Rows.Count).Find(what:="")
CRow = cCell.Row - 1
WSC.Range("X" & MinRowC & ":X" & CRow).Value = "Completed"
End If
WSC.Range("ZZ:ZZ").Delete
'---> b)Put today's date in Col U of sheet Orbit Dump.
'---> Create Formula to find items in both Orbit Dump and in Checksheets-ALL
' =IF(ISERROR(VLOOKUP(A2,Checksheets-ALL!A:A,1)),"",A2)
WSD.Range("ZZ" & MinRowD & ":ZZ" & MaxRowD).Formula = "=IF(ISERROR(VLOOKUP(A" & MinRowD & ",'Checksheets-ALL'!A:A,1)),"""",A" & MinRowD & ")"
WSD.Range("ZZ" & MinRowD & ":ZZ" & MaxRowD).Copy
WSD.Range("ZZ" & MinRowD).PasteSpecial xlPasteValues
WSD.Range("A" & MinRowD & ":ZZ" & MaxRowD).Sort Key1:=WSD.Range("ZZ" & MinRowD), order1:=xlDescending, Header:=xlNo
If WSD.Range("ZZ" & MinRowD) <> "" Then
Set cCell = WSD.Range("ZZ" & MinRowD & ":ZZ" & WSD.Rows.Count).Find(what:="")
DRow = cCell.Row - 1
WSD.Range("U" & MinRowD & ":U" & DRow).Value = DateValue(Now)
End If
WSD.Range("ZZ:ZZ").Delete
'---> 2) If the unique identifier exist in sheet Orbit Dump but DOES not exist in sheet Checksheets-All then
' Add the item in Col A of sheet Checksheets-All and put today's date in Col Y
'---> Run check on Orbit Dump
'---> Create Formula to find items in Orbit Dump but not in Checksheets-ALL
' =IF(ISERROR(VLOOKUP(A2,Control!A:A,1)),A2,"")
WSD.Range("ZZ" & MinRowD & ":ZZ" & MaxRowD).Formula = "=IF(ISERROR(VLOOKUP(A" & MinRowD & ",'Checksheets-ALL'!A:A,1)),A" & MinRowD & ","""")"
WSD.Range("ZZ" & MinRowD & ":ZZ" & MaxRowD).Copy
WSD.Range("ZZ" & MinRowD).PasteSpecial xlPasteValues
WSD.Range("A" & MinRowD & ":ZZ" & MaxRowD).Sort Key1:=WSD.Range("ZZ" & MinRowD), order1:=xlDescending, Header:=xlNo
If WSD.Range("ZZ" & MinRowD) <> "" Then
Set cCell = WSD.Range("ZZ" & MinRowD & ":ZZ" & WSD.Rows.Count).Find(what:="")
DRow = cCell.Row - 1
WSD.Range("ZZ" & MinRowD & ":ZZ" & DRow).Copy WSC.Range("A" & MaxRowC + 1)
WSC.Range("Y" & MaxRowC + 1 & ":Y" & MaxRowC + 1 + DRow - 1).Value = DateValue(Now)
End If
WSD.Range("ZZ:ZZ").Delete
'---> 3) If the Unique Number exist in sheet Checksheets-All but DOES not exist in sheet Orbit Dump
' it just needs to show "Removed" in Column X "Check Sheet Status" of sheet Checksheets-All
' Create Formula to find items in Checksheets-ALL and NOT in Orbit Dump
' =IF(ISERROR(VLOOKUP(A2,Orbit Dump!A:A,1)),A2,"")
WSC.Range("ZZ" & MinRowC & ":ZZ" & MaxRowC).Formula = "=IF(ISERROR(VLOOKUP(A" & MinRowC & ",'Orbit Dump'!A:A,1)),A" & MinRowC & ","""")"
WSC.Range("ZZ" & MinRowC & ":ZZ" & MaxRowC).Copy
WSC.Range("ZZ" & MinRowC).PasteSpecial xlPasteValues
WSC.Range("A" & MinRowC & ":ZZ" & MaxRowC).Sort Key1:=WSC.Range("ZZ" & MinRowC), order1:=xlDescending, Header:=xlNo
If WSC.Range("ZZ" & MinRowC) <> "" Then
Set cCell = WSC.Range("ZZ" & MinRowC & ":ZZ" & WSC.Rows.Count).Find(what:="")
CRow = cCell.Row - 1
WSC.Range("X" & MinRowC & ":X" & CRow).Value = "Removed"
End If
WSC.Range("ZZ:ZZ").Delete
'---> Sort Control on Col A
WSC.Range("A" & MinRowC & ":ZZ" & MaxRowC + DRow).Sort Key1:=WSC.Range("A" & MinRowC), order1:=xlAscending, Header:=xlNo
WSC.Range("A" & MinRowC).Select
'---> Ensable Events
With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "Daily Update Done !", vbExclamation
End Sub
If the Unique Number is no longer in Orbit, it can stay in Checksheets-ALL as well as the actuals, it just needs to show "Removed" or "Deleted" in Column X "Check Sheet Status"
I guess Daily Update is the one we already developed.
Where do you want this new macro to be kicked of ? shall we add a new button or it to be activated after completion of Daily Update with no new button ??
And what I see there is no use of the Mapping so far in this question at this point. Right ??
gowflow
The macro can come after "Daily Update"
The mapping is part of the final Daily update.
Sub DailyUpdate()
Dim WSC As Worksheet
Dim WSD As Worksheet
Dim WSM As Worksheet
Dim MaxRowC As Long, MaxRowD As Long, MaxRowM As Long, I As Long
Dim MinRowC As Long, MinRowD As Long
Dim CRow As Long, DRow As Long
Dim cCell As Range
Dim sColD As String, sColC As String
'---> Disable Events
With Application
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
'---> Set Variables
Set WSC = Sheets("Checksheets-ALL")
MaxRowC = WSC.Range("A" & WSC.Rows.Count).End(xlUp).Row
MinRowC = 9
Set WSD = Sheets("Orbit Dump")
MaxRowD = WSD.Range("A" & WSD.Rows.Count).End(xlUp).Row
MinRowD = 2
Set WSM = Sheets("Mapping")
MaxRowM = WSM.Range("A" & WSM.Rows.Count).End(xlUp).Row
'---> 1) If the unique identifier exist in both Checksheets-All and Orbit Dump then:
' a) Put "Completed" in Col X in sheet Checksheets-All
' b) Put today's date in Col U of sheet Orbit Dump.
'---> a) Put "Completed" in Col X in sheet Checksheets-All
' Create Formula to find items in Checksheets-ALL and in Orbit Dump
' =IF(ISERROR(VLOOKUP(A2,Orbit Dump!A:A,1)),"",A2)
WSC.Range("ZZ" & MinRowC & ":ZZ" & MaxRowC).Formula = "=IF(ISERROR(VLOOKUP(A" & MinRowC & ",'Orbit Dump'!A:A,1)),"""",A" & MinRowC & ")"
WSC.Range("ZZ" & MinRowC & ":ZZ" & MaxRowC).Copy
WSC.Range("ZZ" & MinRowC).PasteSpecial xlPasteValues
WSC.Range("A" & MinRowC & ":ZZ" & MaxRowC).Sort Key1:=WSC.Range("ZZ" & MinRowC), order1:=xlDescending, Header:=xlNo
If WSC.Range("ZZ" & MinRowC) <> "" Then
Set cCell = WSC.Range("ZZ" & MinRowC & ":ZZ" & WSC.Rows.Count).Find(what:="")
CRow = cCell.Row - 1
WSC.Range("X" & MinRowC & ":X" & CRow).Value = "Completed"
End If
WSC.Range("ZZ:ZZ").Delete
'---> b)Put today's date in Col U of sheet Orbit Dump.
'---> Create Formula to find items in both Orbit Dump and in Checksheets-ALL
' =IF(ISERROR(VLOOKUP(A2,Checksheets-ALL!A:A,1)),"",A2)
WSD.Range("ZZ" & MinRowD & ":ZZ" & MaxRowD).Formula = "=IF(ISERROR(VLOOKUP(A" & MinRowD & ",'Checksheets-ALL'!A:A,1)),"""",A" & MinRowD & ")"
WSD.Range("ZZ" & MinRowD & ":ZZ" & MaxRowD).Copy
WSD.Range("ZZ" & MinRowD).PasteSpecial xlPasteValues
WSD.Range("A" & MinRowD & ":ZZ" & MaxRowD).Sort Key1:=WSD.Range("ZZ" & MinRowD), order1:=xlDescending, Header:=xlNo
If WSD.Range("ZZ" & MinRowD) <> "" Then
Set cCell = WSD.Range("ZZ" & MinRowD & ":ZZ" & WSD.Rows.Count).Find(what:="")
DRow = cCell.Row - 1
WSD.Range("U" & MinRowD & ":U" & DRow).Value = DateValue(Now)
End If
WSD.Range("ZZ:ZZ").Delete
'---> 2) If the unique identifier exist in sheet Orbit Dump but DOES not exist in sheet Checksheets-All then
' Add the item in Col A of sheet Checksheets-All and put today's date in Col Y
'---> Run check on Orbit Dump
'---> Create Formula to find items in Orbit Dump but not in Checksheets-ALL
' a) Create the Record in Checksheets-ALL
' =IF(ISERROR(VLOOKUP(A2,Control!A:A,1)),A2,"")
WSD.Range("ZZ" & MinRowD & ":ZZ" & MaxRowD).Formula = "=IF(ISERROR(VLOOKUP(A" & MinRowD & ",'Checksheets-ALL'!A:A,1)),A" & MinRowD & ","""")"
WSD.Range("ZZ" & MinRowD & ":ZZ" & MaxRowD).Copy
WSD.Range("ZZ" & MinRowD).PasteSpecial xlPasteValues
WSD.Range("A" & MinRowD & ":ZZ" & MaxRowD).Sort Key1:=WSD.Range("ZZ" & MinRowD), order1:=xlDescending, Header:=xlNo
If WSD.Range("ZZ" & MinRowD) <> "" Then
Set cCell = WSD.Range("ZZ" & MinRowD & ":ZZ" & WSD.Rows.Count).Find(what:="")
DRow = cCell.Row - 1
WSD.Range("ZZ" & MinRowD & ":ZZ" & DRow).Copy WSC.Range("A" & MaxRowC + 1)
WSC.Range("Y" & MaxRowC + 1 & ":Y" & MaxRowC + 1 + DRow - 1).Value = DateValue(Now)
End If
'---> b) Create the remaining fields as per Mapping in Checksheets-ALL for the created records.
For I = 2 To MaxRowM
sColD = Trim(WSM.Cells(I, "B"))
sColC = Trim(WSM.Cells(I, "A"))
'---> Copy the row's column into it's proper one in Checksheets-ALL for all
' the new created items fom Orbit Dump.
If sColC <> "A" And sColD <> "" And sColC <> "Y" Then
WSD.Range(sColD & MinRowD & ":" & sColD & DRow).Copy
WSC.Range(sColC & MaxRowC + 1).PasteSpecial xlPasteValues
End If
Next I
WSD.Range("ZZ:ZZ").Delete
'---> 3) If the Unique Number exist in sheet Checksheets-All but DOES not exist in sheet Orbit Dump
' it just needs to show "Removed" in Column X "Check Sheet Status" of sheet Checksheets-All
' Create Formula to find items in Checksheets-ALL and NOT in Orbit Dump
' =IF(ISERROR(VLOOKUP(A2,Orbit Dump!A:A,1)),A2,"")
WSC.Range("ZZ" & MinRowC & ":ZZ" & MaxRowC).Formula = "=IF(ISERROR(VLOOKUP(A" & MinRowC & ",'Orbit Dump'!A:A,1)),A" & MinRowC & ","""")"
WSC.Range("ZZ" & MinRowC & ":ZZ" & MaxRowC).Copy
WSC.Range("ZZ" & MinRowC).PasteSpecial xlPasteValues
WSC.Range("A" & MinRowC & ":ZZ" & MaxRowC).Sort Key1:=WSC.Range("ZZ" & MinRowC), order1:=xlDescending, Header:=xlNo
If WSC.Range("ZZ" & MinRowC) <> "" Then
Set cCell = WSC.Range("ZZ" & MinRowC & ":ZZ" & WSC.Rows.Count).Find(what:="")
CRow = cCell.Row - 1
WSC.Range("X" & MinRowC & ":X" & CRow).Value = "Removed"
End If
WSC.Range("ZZ:ZZ").Delete
'---> Sort Control on Col A
WSC.Range("A" & MinRowC & ":ZZ" & MaxRowC + DRow).Sort Key1:=WSC.Range("A" & MinRowC), order1:=xlAscending, Header:=xlNo
WSC.Range("A" & MinRowC).Select
'---> Ensable Events
With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "Daily Update Done !", vbExclamation
End Sub
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.