Count only Once and then add to counter for year

K

kodiac9

New Member
Joined
Jun 27, 2011
Messages
13
Hi Everyone

Here's my code
Code: 
Sub Macro1()
''
   Dim iLastRow As Integer
   Dim Rng, Rng2 As Range
   Dim Monthd, Yeard As Integer
   Dim yr2008, yr2009, yr2010, yr2011, yr2012, yr2013, yr2014, yr2015, yr2016, yr2017, yr2018, yr2019, yr2020, yr2021, yr2022, yr2023, yr2024, yr2025, yr2026, yr2027, yr2028, yr2029, yr2030 As Integer
   Dim Av2008, Av2009, Av2010, Av2011, Av2012, Av2013, Av2014, Av2015, Av2016, Av2017, Av2018, Av2019, Av2020, Av2021, Av2022, Av2023, Av2024, Av2025, Av2026, Av2027, Av2028, Av2029, Av2030 As Integer
'============ COLORATION =======================
   iLastRow = Cells(Rows.Count, "a").End(xlUp).Row
Application.Goto ActiveWorkbook.Sheets("Sheet 1").Cells(4, 3)
   For Each Rng In Range("j4:j" & iLastRow)
      If Not Rng.Value = vbNullString Then
    Rng.Select
    Monthd = Rng.Value
 '   Yeard = ActiveCell.Value
 Else
          Rng.Select
     ActiveCell.Offset(0, -7).Range("A1").Select
        Monthd = Month(ActiveCell.Value)
     ActiveCell.Offset(0, -1).Range("A1").Select
'Yeard = Year(Rng.Value)
      End If
 
      Rng.Select
      ActiveCell.Offset(0, -1).Range("A1").Select
 
      If ActiveCell.Value = 0 Or ActiveCell.Value = "" Then
      Selection.Interior.ColorIndex = 0
      Else
      If Monthd = 1 Then
      Selection.Interior.ColorIndex = 43
      ElseIf Monthd = 2 Then
      Selection.Interior.ColorIndex = 20
      ElseIf Monthd = 3 Then
      Selection.Interior.ColorIndex = 27
      ElseIf Monthd = 4 Then
      Selection.Interior.ColorIndex = 40
      ElseIf Monthd = 5 Then
      Selection.Interior.ColorIndex = 39
      ElseIf Monthd = 6 Then
      Selection.Interior.ColorIndex = 17
      ElseIf Monthd = 7 Then
      Selection.Interior.ColorIndex = 15
      ElseIf Monthd = 8 Then
      Selection.Interior.ColorIndex = 45
      ElseIf Monthd = 9 Then
      Selection.Interior.ColorIndex = 12
      ElseIf Monthd = 10 Then
      Selection.Interior.ColorIndex = 33
      ElseIf Monthd = 11 Then
      Selection.Interior.ColorIndex = 38
      ElseIf Monthd = 12 Then
      Selection.Interior.ColorIndex = 22
      End If
      End If
      Next Rng
'================END COLORATION ==============
'================DONNÉES TOTALES==============
'   iLastRow = Cells(Rows.Count, "a").End(xlUp).Row
Application.Goto ActiveWorkbook.Sheets("Sheet 1").Cells(4, 3)
   For Each Rng In Range("j4:j" & iLastRow)
   '======== SELECT DATE =============
         If Not Rng.Value = vbNullString Then
    Rng.Select
    Monthd = Rng.Value
     ActiveCell.Offset(0, 2).Range("A1").Select
    Yeard = ActiveCell.Value
 '   Yeard = ActiveCell.Value
 Else
          Rng.Select
     ActiveCell.Offset(0, -7).Range("A1").Select
        Monthd = Month(ActiveCell)
        Yeard = Year(ActiveCell)
      End If
    '========= END SELECT DATE ==========
    Rng.Select
    ActiveCell.Offset(0, -1).Range("A1").Select
    Select Case Yeard
    Case Is = 2008
    yr2008 = yr2008 + ActiveCell.Value
 
    ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2008 = Av2008 + 1
    End If
 
        Case Is = 2009
    yr2009 = yr2009 + ActiveCell.Value
 
        ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2009 = Av2009 + 1
    End If
 
        Case Is = 2010
    yr2010 = yr2010 + ActiveCell.Value
 
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2010 = Av2010 + 1
    End If
 
        Case Is = 2011
    yr2011 = yr2011 + ActiveCell.Value
 
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2011 = Av2011 + 1
    End If
        Case Is = 2012
    yr2012 = yr2012 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2012 = Av2012 + 1
    End If
        Case Is = 2013
    yr2013 = yr2013 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2013 = Av2013 + 1
    End If
        Case Is = 2014
    yr2014 = yr2014 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2014 = Av2014 + 1
    End If
        Case Is = 2015
    yr2015 = yr2015 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2015 = Av2015 + 1
    End If
        Case Is = 2016
    yr2016 = yr2016 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2016 = Av2016 + 1
    End If
        Case Is = 2017
    yr2017 = yr2017 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2017 = Av2017 + 1
    End If
        Case Is = 2018
    yr2018 = yr2018 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2018 = Av2018 + 1
    End If
        Case Is = 2019
    yr2019 = yr2019 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2019 = Av2019 + 1
    End If
        Case Is = 2020
    yr2020 = yr2020 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2020 = Av2020 + 1
    End If
        Case Is = 2021
    yr2021 = yr2021 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2021 = Av2021 + 1
    End If
        Case Is = 2022
    yr2022 = yr2022 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2022 = Av2022 + 1
    End If
        Case Is = 2023
    yr2023 = yr2023 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2023 = Av2023 + 1
    End If
        Case Is = 2024
    yr2024 = yr2024 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2024 = Av2024 + 1
    End If
        Case Is = 2025
    yr2025 = yr2025 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2025 = Av2025 + 1
    End If
        Case Is = 2026
    yr2026 = yr2026 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2026 = Av2026 + 1
    End If
        Case Is = 2027
    yr2027 = yr2027 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2027 = Av2027 + 1
    End If
        Case Is = 2028
    yr2028 = yr2028 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2028 = Av2028 + 1
    End If
        Case Is = 2029
    yr2029 = yr2029 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2029 = Av2029 + 1
    End If
        Case Is = 2030
    yr2030 = yr2030 + ActiveCell.Value
            ActiveCell.Offset(0, -7).Range("A1").Select
    If InStr(1, ActiveCell.Value, "Avenant", vbTextCompare) <> 0 Then
    Av2030 = Av2030 + 1
    End If
    Case Else
    End Select
   Next Rng
   MsgBox (Av2010)
'==== Start Print Totals =======
Application.Goto ActiveWorkbook.Sheets("Sheet 2").Cells(6, 6)
ActiveCell.FormulaR1C1 = yr2008
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2008
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2009
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2009
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2010
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2010
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2011
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2011
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2012
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2012
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2013
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2013
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2014
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2014
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2015
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2015
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2016
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2016
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2017
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2017
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2018
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2018
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2019
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2019
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2020
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2020
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2021
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2021
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2022
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2022
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2023
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2023
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2024
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2024
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2025
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2025
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2026
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2026
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2027
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2027
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2028
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2028
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2029
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2029
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = yr2030
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Av2030
'==== End print Totals =======
End Sub

Yeah it's a mess :S, but it works


Now, in the second loop i would like to add a part that is something like

Count number of times it reads a row for column E, but count the items in E only once if they are repeated.

And all that only for each year in column L(just year entered in text) or C (Entered as date)

(see code to undestand this a little bit more)


columns are as

A Name
B Title of the event
C Effective date
D Inv no.
E Cert no.
F Price 1
G Price 2
H Price3
I Total
J Billed (month)
K (empty space)
L Billed (year)
 
Last edited:

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
Also when i run this macro in Sheet1 it works fine, but when i run it in other sheets it doesn't do it on sheet 1, yet i tried both select and activate methods.
 
Upvote 0
ok i fixed the macro not working fine, the range was calculated before selecting the sheet.

but now i still need to do the following logic

For each row

If date(cell L or C) is date 2008
check if repeated then add +1 to counter av2008
if repeated do nothing

If date(cell L or C) is date 2009
check if repeated then add +1 to counter av2009
if repeated do nothing

etc...
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Tab Selection from Userform based on Date range
Replies
5
Views
156
campbell1093
C
A
  • Solved
VBA Case Error
Replies
2
Views
64
Ark68
A
G
  • Question Question
How can i extract the correct leave time on this code?
Replies
1
Views
557
rlv01
R
J
  • Question Question
VBA Code to Add Rows is slowing down
Replies
5
Views
999
JayB0730
J
T
  • Question Question
Years together I was using a macro for automate a w/book is not as on today why?
Replies
1
Views
479
GlennUK
G

Forum statistics

Threads
1,224,564
Messages
6,179,543
Members
452,924
Latest member
JackiG

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top