KjBox OzMVP - Moderator

Male
from Kuching, Borneo
Member since Jan 10th 2007

Last Activity: Tuesday, 5:17 am

Posts: 4,345
Likes Received: 35
Points: 22,221
Profile Hits: 833

cobber1418 Jan 1st 2020
Hi KJBox, hope you had a good new year.
You provided me with the below codes that worked great...but since we changed to 2020 I get nothing counted at all. is there a problem with the date in the code?

Code

Sub GetCountsCurrentMonth()

Dim x, y, Rws, ContAreas, i As Long, ii As Long

Const Category As String = "Work"

Const Status As String = "Processed"

Const DtCol As Long = 11 '// Change to suit (11 = column K)

Rws = Array(5, 6, 7, 8, 9, 17, 18, 19, 20, 21, 22, 23, 24, 32, 33, 34, 35, 36)

ContAreas = Array("WSCA1", "WSCA2", "SECA11", "SECA12", "SECA13", "NWCA5", "NWCA6A", _

"NWCA6B", "NWCA7", "NWCA8", "NWCA9", "NWCA10A", "NWCA10B", _

"WSCA3", "WSCA4", "SECA14", "SECA15", "SECA16")

x = Sheet1.[a6].CurrentRegion

ReDim y(1 To 36, 1 To 1)

For i = 2 To UBound(x, 1)

If Year(x(i, DtCol)) = Year(Date) And Month(x(i, DtCol)) = Month(Date) _

And x(i, 4) = Category And x(i, 13) = Status Then

For ii = LBound(ContAreas) To UBound(ContAreas)

If ContAreas(ii) = x(i, 12) Then y(Rws(ii), 1) = y(Rws(ii), 1) + 1

Next

End If

Next

With Sheet2

.[e1].Resize(36) = y

.Activate

End With

End Sub

Display More

Code

Sub GetCountsPreviousMonth()

Dim x, y, Rws, ContAreas, i As Long, ii As Long

Const Category As String = "Work"

Const Status As String = "Processed"

Const DtCol As Long = 11 '// Change to suit (11 = column K)

Rws = Array(5, 6, 7, 8, 9, 17, 18, 19, 20, 21, 22, 23, 24, 32, 33, 34, 35, 36)

ContAreas = Array("WSCA1", "WSCA2", "SECA11", "SECA12", "SECA13", "NWCA5", "NWCA6A", _

"NWCA6B", "NWCA7", "NWCA8", "NWCA9", "NWCA10A", "NWCA10B", _

"WSCA3", "WSCA4", "SECA14", "SECA15", "SECA16")

x = Sheet1.[a6].CurrentRegion

ReDim y(1 To 36, 1 To 1)

For i = 2 To UBound(x, 1)

If Year(x(i, DtCol)) = Year(Date) And Month(x(i, DtCol)) = Month(Date) - 1 _

And x(i, 4) = Category And x(i, 13) = Status Then

For ii = LBound(ContAreas) To UBound(ContAreas)

If ContAreas(ii) = x(i, 12) Then y(Rws(ii), 1) = y(Rws(ii), 1) + 1

Next

End If

Next

With Sheet2

.[e1].Resize(36) = y

.Activate

End With

End Sub

Display More

Code

Sub GetCountsCurrentQuarter()

Dim x, y, Rws, ContAreas, i As Long, ii As Long

Const Category As String = "Work"

Const Status As String = "Processed"

Const DtCol As Long = 11 '// Change to suit (11 = column K)

Rws = Array(5, 6, 7, 8, 9, 17, 18, 19, 20, 21, 22, 23, 24, 32, 33, 34, 35, 36)

ContAreas = Array("WSCA1", "WSCA2", "SECA11", "SECA12", "SECA13", "NWCA5", "NWCA6A", _

"NWCA6B", "NWCA7", "NWCA8", "NWCA9", "NWCA10A", "NWCA10B", _

"WSCA3", "WSCA4", "SECA14", "SECA15", "SECA16")

x = Sheet1.[a6].CurrentRegion

ReDim y(1 To 36, 1 To 1)

For i = 2 To UBound(x, 1)

If Year(x(i, DtCol)) = Year(Date) And DatePart("q", x(i, DtCol)) = DatePart("q", Date) _

And x(i, 4) = Category And x(i, 13) = Status Then

For ii = LBound(ContAreas) To UBound(ContAreas)

If ContAreas(ii) = x(i, 12) Then y(Rws(ii), 1) = y(Rws(ii), 1) + 1

Next

End If

Next

With Sheet2

.[e1].Resize(36) = y

.Activate

End With

End Sub

Display More

Code

Sub GetCountsPreviousQuarter()

Dim x, y, Rws, ContAreas, i As Long, ii As Long

Const Category As String = "Work"

Const Status As String = "Processed"

Const DtCol As Long = 11 '// Change to suit (11 = column K)

Rws = Array(5, 6, 7, 8, 9, 17, 18, 19, 20, 21, 22, 23, 24, 32, 33, 34, 35, 36)

ContAreas = Array("WSCA1", "WSCA2", "SECA11", "SECA12", "SECA13", "NWCA5", "NWCA6A", _

"NWCA6B", "NWCA7", "NWCA8", "NWCA9", "NWCA10A", "NWCA10B", _

"WSCA3", "WSCA4", "SECA14", "SECA15", "SECA16")

x = Sheet1.[a6].CurrentRegion

ReDim y(1 To 36, 1 To 1)

For i = 2 To UBound(x, 1)

If Year(x(i, DtCol)) = Year(Date) And DatePart("q", x(i, DtCol)) = DatePart("q", Date) - 1 _

And x(i, 4) = Category And x(i, 13) = Status Then

For ii = LBound(ContAreas) To UBound(ContAreas)

If ContAreas(ii) = x(i, 12) Then y(Rws(ii), 1) = y(Rws(ii), 1) + 1

Next

End If

Next

With Sheet2

.[e1].Resize(36) = y

.Activate

End With

End Sub

Display More
Report Content
- cobber1418 Jan 2nd 2020
  
  Hi KjBox just reminding you the code you gave me has Option Base 1 in it and now the data has some 2020 dates in it they appear after I run the macro but none of the 2019 dates
  
  Report Content
Rmrekoj Dec 24th 2019

KjBox if you kind enough to donate some time to me to solve the query which i have posted since no one is replying on that ..thanks u had helped me many times.
Report Content
pijo Nov 25th 2019

I opened a conversation with you about a VBA problem I'm having - mind taking a look?

Thank you!!!
Report Content
Potholes Nov 18th 2019

Good morning and how are we this morning. ????
Report Content
cobber1418 Nov 17th 2019

KjBox is excellent......has helped me so much with VBA codes. A real expert. Thanks for everything.
Report Content

cobber1418 Jan 1st 2020

cobber1418 Jan 2nd 2020

Rmrekoj Dec 24th 2019

pijo Nov 25th 2019

Potholes Nov 18th 2019

cobber1418 Nov 17th 2019