Skip to content

Instantly share code, notes, and snippets.

@xxdesmus
Created January 25, 2011 17:48
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save xxdesmus/795292 to your computer and use it in GitHub Desktop.
Save xxdesmus/795292 to your computer and use it in GitHub Desktop.
' =============================================================
' Insert Earned hours formula and
' calculate all earned hours on CPInutVolume
' =============================================================
xRef1 = Sheets("CPInputVolume").Cells(1, 6) - 19 'formula located in 1F that counts how many rows of data we have, used to loop through code below until end of our data
restartLoop: 'used down below after check for problem data (didn't complete all 3 questions)
Counter1 = 1 'used to match against xRef1 so we know when we reach the bottom of the data
Range("E20").Select
Do Until Counter1 = xRef1 'loop through all of this until counter (starting at 1) reachs xRef1 (starting at the max # of filled rows we have)
CounterSkip = 1 'used below -- runs through first part of loop, in 1 pathway CounterSkip will just remain = 1, in another pathway it'll be changed to = 0 at which point it then does another step below
If (ActiveCell.Offset(0, -2).Value = 7 And ActiveCell.Offset(0, -4).Value = ActiveCell.Offset(1, -4).Value) And ActiveCell.Offset(1, -2).Value = 6 Then 'we verified we have 2 matching dates and we have order = PID 7 then PID 6
If (ActiveCell.Offset(0, -1).Value = "S01" Or ActiveCell.Offset(0, -1).Value = "S04" Or ActiveCell.Offset(0, -1).Value = "S05") Then 'if PID 7 and Activity PID = S01, S04, or S05
ActiveCell.FormulaR1C1 = "0" 'fill a value of 0
ActiveCell.Offset(1, 0).Activate 'move 1 cell down, same column
ActiveCell.FormulaR1C1 = _
"=VALUE(IF('CPInputVolume'!R[-1]C=0.0000,(IF('CPInputVolume'!RC[-1]=""S01"",Setup!R9C15,"""")&IF('CPInputVolume'!RC[-1]=""S03"",Setup!R10C15,"""")&IF('CPInputVolume'!RC[-1]=""S06"",Setup!R11C15,"""")&IF('CPInputVolume'!RC[-1]=""S07"",Setup!R12C15,"""")&IF('CPInputVolume'!RC[-1]=""S08"",Setup!R13C15,"""")&IF('CPInputVolume'!RC[-1]=""S09"",Setup!R14C15,"""")&IF('CPInputVolume'!RC[-1]=""S10"",Setup!R15C15,"""")&IF('CPInputVolume'!RC[-1]=""S11"",Setup!R16C15,"""")),0))" 'fill in forumula to look up RE based on PID 6 -- case type
Counter1 = Counter1 + 2 'increment the counter by 2 because we just moved down 2 rows
CounterSkip = 0
End If
If CounterSkip = 0 Then
ActiveCell.Offset(1, 0).Activate 'move 1 cell down, same column
Else
If (ActiveCell.Offset(0, -1).Value = "S02" Or ActiveCell.Offset(0, -1).Value = "S03" Or ActiveCell.Offset(0, -1).Value = "S06" Or ActiveCell.Offset(0, -1).Value = "S07") Then 'if PID 7 and Activity PID = S02, S03, S06, or S07
ActiveCell.FormulaR1C1 = _
"=VALUE(IF('CPInputVolume'!RC[-1]="""",0,(IF('CPInputVolume'!RC[-1]=""S02"",Setup!R3C15,0)&IF(RC[-1]=""S03"",Setup!R4C15,0)&IF('CPInputVolume'!RC[-1]=""S06"",Setup!R7C15,0)&IF(RC[-1]=""S07"",Setup!R8C15,0))))" 'formula for PID 7 RE lookup -- decision
ActiveCell.Offset(1, 0).Activate 'move 1 cell down, same column
ActiveCell.FormulaR1C1 = "0" 'fill a value of 0
ActiveCell.Offset(1, 0).Activate 'move 1 cell down, same column
Counter1 = Counter1 + 1
End If
End If
Else ' this is a check to see if we are at the end of the data (2 blank rows after eachother) or if someone didn't fill out the EQ correctly and we're missing a value. 1st pathway looks for 2 blank rows. 2nd pathway looks if the EQ was filled out wrong
If (ActiveCell.Offset(0, -4).Value = Empty And ActiveCell.Offset(1, -4).Value = Empty) Then 'see if we have 2 blank rows, break out if we do, otherwise go down to the Else and report an error
GoTo breakOut 'go to the point "breakOut" below if you reached the end of the data (2 blank rows)
Else
ProblemName = ActiveCell.Offset(0, -3).Value 'fill problemName with the user ID of the person who didn't fill out all 3 questions
ProblemDate = ActiveCell.Offset(0, -4).Value 'fill problemDate with the date of the case when they didn't fill out all 3 questions
Debug.Print ProblemName 'output ProblemName to the Immediate Window. View --> Immediate Window
Debug.Print ProblemDate 'output ProblemDate to the Immediate Window. View --> Immediate Window
ActiveCell.EntireRow.Select 'select the problem row
Selection.Delete Shift:=xlUp 'delete the selected row, shift up all following rows
GoTo restartLoop 'go to the point "restartLoop" up above and retry this entire process
End If
End If
Loop
breakOut:
Counter1 = 0
@xxdesmus
Copy link
Author

Some context here -- this is a section from an Excel 2003 file I had to create for work. Basically it's taking 3 different sources of input, matches based on username across the 3 sources, and then running a series of lookups before running calculations based on those lookups.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment