Sub FlashyMacro()
Screen Update = False
Dim Row1 As Double, Row2 As Double, Row3 As Double, SheetOnScreen As String
Application.Calculation = xlManual
Row1 = 4
Row2 = 2
Row3 = 2
SheetOnScreen = ActiveCell.Worksheet.Name
If SheetOnScreen <> "Sheet3" Then
SheetOnScreen = "Sheet2"
End If
Worksheets(SheetOnScreen).Activate
If (SheetOnScreen = "Sheet2") Then
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select
Else
Worksheets("Sheet3").Cells(Row3 + 1, 1).Select
End If
Worksheets("Sheet2").Cells(Row2, 1) = ""
Worksheets("Sheet2").Cells(Row2, 2) = ""
Worksheets("Sheet2").Cells(Row2, 3) = ""
Worksheets("Sheet2").Cells(Row2, 4) = ""
Worksheets("Sheet2").Cells(Row2, 5) = ""
Worksheets("Sheet3").Cells(Row3, 1) = ""
Worksheets("Sheet3").Cells(Row3, 2) = ""
Worksheets("Sheet3").Cells(Row3, 3) = ""
Worksheets("Sheet3").Cells(Row3, 4) = ""
Worksheets("Sheet3").Cells(Row3, 5) = ""
While Worksheets("Sheet1").Cells(Row1, 1) <> ""
If Worksheets("Sheet1").Cells(Row1, 1) = "In" Then
If Worksheets("Sheet2").Cells(Row2, 1) = "" Then
Worksheets("Sheet2").Cells(Row2, 1) = Worksheets("Sheet1").Cells(Row1, 2)
Worksheets("Sheet2").Cells(Row2, 2) = Worksheets("Sheet1").Cells(Row1, 5)
Worksheets("Sheet2").Cells(Row2, 3) = Worksheets("Sheet1").Cells(Row1, 6)
Worksheets("Sheet2").Cells(Row2, 4) = Worksheets("Sheet1").Cells(Row1, 7)
Worksheets("Sheet2").Cells(Row2, 5) = Worksheets("Sheet1").Cells(Row1, 8)
Else
Worksheets("Sheet2").Cells(Row2, 2) = Worksheets("Sheet2").Cells(Row2, 2) + Worksheets("Sheet1").Cells(Row1, 5)
Worksheets("Sheet2").Cells(Row2, 3) = Worksheets("Sheet2").Cells(Row2, 3) + Worksheets("Sheet1").Cells(Row1, 6)
Worksheets("Sheet2").Cells(Row2, 4) = Worksheets("Sheet2").Cells(Row2, 4) + Worksheets("Sheet1").Cells(Row1, 7)
Worksheets("Sheet2").Cells(Row2, 5) = Worksheets("Sheet2").Cells(Row2, 5) + Worksheets("Sheet1").Cells(Row1, 8)
End If
End If
If Worksheets("Sheet1").Cells(Row1, 1) = "Out" Then
If Worksheets("Sheet3").Cells(Row3, 1) = "" Then
Worksheets("Sheet3").Cells(Row3, 1) = DateSerial(Year(Worksheets("Sheet1").Cells(Row1, 3)), Month(Worksheets("Sheet1").Cells(Row1, 3)), 1)
Worksheets("Sheet3").Cells(Row3, 2) = Worksheets("Sheet1").Cells(Row1, 5)
Worksheets("Sheet3").Cells(Row3, 3) = Worksheets("Sheet1").Cells(Row1, 6)
Worksheets("Sheet3").Cells(Row3, 4) = Worksheets("Sheet1").Cells(Row1, 7)
Worksheets("Sheet3").Cells(Row3, 5) = Worksheets("Sheet1").Cells(Row1, 8)
Else
Worksheets("Sheet3").Cells(Row3, 2) = Worksheets("Sheet3").Cells(Row3, 2) + Worksheets("Sheet1").Cells(Row1, 5)
Worksheets("Sheet3").Cells(Row3, 3) = Worksheets("Sheet3").Cells(Row3, 3) + Worksheets("Sheet1").Cells(Row1, 6)
Worksheets("Sheet3").Cells(Row3, 4) = Worksheets("Sheet3").Cells(Row3, 4) + Worksheets("Sheet1").Cells(Row1, 7)
Worksheets("Sheet3").Cells(Row3, 5) = Worksheets("Sheet3").Cells(Row3, 5) + Worksheets("Sheet1").Cells(Row1, 8)
End If
End If
Row1 = Row1 + 1
If Worksheets("Sheet1").Cells(Row1, 1) = "In" And Worksheets("Sheet2").Cells(Row2, 1) <> Worksheets("Sheet1").Cells(Row1, 2) Then
Row2 = Row2 + 1
If (SheetOnScreen = "Sheet2") Then
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select
End If
Worksheets("Sheet2").Cells(Row2, 1) = ""
Worksheets("Sheet2").Cells(Row2, 2) = ""
Worksheets("Sheet2").Cells(Row2, 3) = ""
Worksheets("Sheet2").Cells(Row2, 4) = ""
Worksheets("Sheet2").Cells(Row2, 5) = ""
End If
If Worksheets("Sheet1").Cells(Row1, 1) = "Out" And Worksheets("Sheet3").Cells(Row3, 1) <> "" And Month(Worksheets("Sheet3").Cells(Row3, 1)) <> Month(Worksheets("Sheet1").Cells(Row1, 3)) Then
Row3 = Row3 + 1
If (SheetOnScreen = "Sheet3") Then
Worksheets("Sheet3").Cells(Row3 + 1, 1).Select
End If
Worksheets("Sheet3").Cells(Row3, 1) = ""
Worksheets("Sheet3").Cells(Row3, 2) = ""
Worksheets("Sheet3").Cells(Row3, 3) = ""
Worksheets("Sheet3").Cells(Row3, 4) = ""
Worksheets("Sheet3").Cells(Row3, 5) = ""
End If
Wend
Worksheets("Sheet1").Activate
Worksheets("Sheet1").Cells(Row1, 1).Select
Worksheets("Sheet3").Activate
Worksheets("Sheet3").Cells(Row3 + 1, 1).Select
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select
Calculate
Application.Calculation = xlAutomatic
Worksheets(SheetOnScreen).Activate
End Sub
Bookmarks