Counter help (1 Viewer)

goncalo

Member
Local time
Today, 22:53
Joined
May 23, 2023
Messages
51
Hello everyone
I recently made the code below which reads the values inside certain columns and verifies if they are all on the same row and increments if the combination is the same as the one defined
But now i want to add another feature to it and im not sure how to go about doing it which is why i need help
Basically there is column G in my second sheet(same sheet that receives all the other values) that receives dates in the format "dd/mm/yyyy" and i would like it so that depending on the week number associated with said date the counter would be placed in a different row in sheet15.

for example lets say that there are only these 5 rows filed in the columns i defined and these are the values present in that sheet :

1687523049585.png


i would want there to be 2 counters,1 for the row with : 1, 2, 3, 3/2/0, 28/09/2023 and 1, 2, 3, 3/1/0, 29/09/2023 and another counter for 1, 2, 3, 3/1/0, 05/06/2023
the first counter would have the number 2 being displayed because 2 rows have the correct combination and they share the same weeknumber associated with their dates and the other counter would have 1 because there's only one row present with the correct combination of values that has the same weeknumber
i also would want the counters to be displayed in the same row number as their weeknumber so the first counter i mentioned would be displayed in row 39 and the other one would be displayed in row 23
Im sorry if what im asking here is confusing,if you have any question ask away and ill try my best to answer
Thank you for reading

Code:
Sub Button1_Click() 'Leaks
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Dim searchRange As Range
    Dim countRange As Range
    Dim count As Long
    Dim searchValue1 As String
    Dim searchValue2 As String
    Dim searchValue3 As String
    Dim searchValue4 As Variant ' Change the data type to Variant
   
    ' Define the search range in Sheet2 where you want to look for the data combination
    Set searchRange = Sheet2.Range("B1:H" & Sheet2.Cells(Rows.count, "H").End(xlUp).row) ' Modify the range as per your data
   
    ' Define the range in Sheet15 where you want to store the count
    Set countRange = Sheet15.Range("P1") ' Modify the cell as per your preference
   
    ' Clear previous count
    countRange.value = ""
   
    ' Define the search values (combination of data)
    searchValue1 = "1"
    searchValue2 = "2"
    searchValue3 = "3"
    searchValue4 = Array("3/1/0", "3/2/0") ' Modify the values as per your requirement
   
    ' Convert the search range to a variant array for faster processing
    Dim dataArr As Variant
    dataArr = searchRange.value
   
    ' Loop through the array to search for the combination of values
    Dim i As Long
    Dim numRows As Long
    Dim foundCount As Long
   
    numRows = UBound(dataArr, 1)
   
    For i = 1 To numRows
        ' Check if each search value is found in the row
        If dataArr(i, 1) = searchValue1 And _
           dataArr(i, 2) = searchValue2 And _
           dataArr(i, 3) = searchValue3 And _
           IsValueInArray(dataArr(i, 7), searchValue4) Then ' Use a helper function to check if value is in array
            foundCount = foundCount + 1
        End If
    Next i
   
    ' Store the count in the count range of Sheet15
    countRange.value = foundCount
   
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Private Function IsValueInArray(value As Variant, arr As Variant) As Boolean
    ' Helper function to check if value is in array
    Dim i As Long
    For i = LBound(arr) To UBound(arr)
        If value = arr(i) Then
            IsValueInArray = True
            Exit Function
        End If
    Next i
    IsValueInArray = False
End Function
 
Last edited:

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 22:53
Joined
Jul 9, 2003
Messages
16,282
ChatGPT Said:-
To add the feature you described, you need to modify the code to calculate the week number for each date in column G and compare it with the week numbers of the rows that match the combination of values. Here's the modified code with the added functionality:

Code:
Sub Button1_Click()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Dim searchRange As Range
    Dim countRange As Range
    Dim count As Long
    Dim searchValue1 As String
    Dim searchValue2 As String
    Dim searchValue3 As String
    Dim searchValue4 As Variant
    Dim weekRange As Range ' Range in Sheet2 containing week numbers
   
    ' Define the search range in Sheet2 where you want to look for the data combination
    Set searchRange = Sheet2.Range("B1:H" & Sheet2.Cells(Rows.Count, "H").End(xlUp).Row)
   
    ' Define the range in Sheet15 where you want to store the count
    Set countRange = Sheet15.Range("P1")
   
    ' Define the range in Sheet2 containing week numbers (column G)
    Set weekRange = Sheet2.Range("G1:G" & Sheet2.Cells(Rows.Count, "G").End(xlUp).Row)
   
    ' Clear previous count
    countRange.Value = ""
   
    ' Define the search values (combination of data)
    searchValue1 = "1"
    searchValue2 = "2"
    searchValue3 = "3"
    searchValue4 = Array("3/1/0", "3/2/0")
   
    ' Convert the search range to a variant array for faster processing
    Dim dataArr As Variant
    dataArr = searchRange.Value
   
    ' Convert the week range to a variant array for faster processing
    Dim weekArr As Variant
    weekArr = weekRange.Value
   
    ' Loop through the array to search for the combination of values
    Dim i As Long
    Dim numRows As Long
    Dim foundCount As Long
   
    numRows = UBound(dataArr, 1)
   
    For i = 1 To numRows
        ' Check if each search value is found in the row and the week number matches
        If dataArr(i, 1) = searchValue1 And _
           dataArr(i, 2) = searchValue2 And _
           dataArr(i, 3) = searchValue3 And _
           IsValueInArray(dataArr(i, 7), searchValue4) And _
           GetWeekNumber(dataArr(i, 7)) = GetWeekNumber(dataArr(i, 6)) Then
            foundCount = foundCount + 1
        End If
    Next i
   
    ' Store the count in the count range of Sheet15
    countRange.Value = foundCount
   
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Private Function IsValueInArray(value As Variant, arr As Variant) As Boolean
    ' Helper function to check if value is in array
    Dim i As Long
    For i = LBound(arr) To UBound(arr)
        If value = arr(i) Then
            IsValueInArray = True
            Exit Function
        End If
    Next i
    IsValueInArray = False
End Function

Private Function GetWeekNumber(dateValue As Date) As Long
    ' Helper function to calculate the week number of a date
    GetWeekNumber = WorksheetFunction.WeekNum(dateValue, vbMonday)
End Function

In this code, I added a new variable weekRange to define the range in Sheet2 containing the week numbers (column G). The GetWeekNumber function uses the WeekNum function from the WorksheetFunction object to calculate the week number for a given date.

Inside the loop, I added an additional condition to check if the week number of the date (GetWeekNumber(dataArr(i, 7))) matches the week number of the row (GetWeekNumber(dataArr(i, 6))). If both week numbers match, the row is considered as a match for the combination of values.

Make sure to adjust the ranges and cell references in the code according to your specific workbook structure.
 

goncalo

Member
Local time
Today, 22:53
Joined
May 23, 2023
Messages
51
ChatGPT Said:-
To add the feature you described, you need to modify the code to calculate the week number for each date in column G and compare it with the week numbers of the rows that match the combination of values. Here's the modified code with the added functionality:

Code:
Sub Button1_Click()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
  
    Dim searchRange As Range
    Dim countRange As Range
    Dim count As Long
    Dim searchValue1 As String
    Dim searchValue2 As String
    Dim searchValue3 As String
    Dim searchValue4 As Variant
    Dim weekRange As Range ' Range in Sheet2 containing week numbers
  
    ' Define the search range in Sheet2 where you want to look for the data combination
    Set searchRange = Sheet2.Range("B1:H" & Sheet2.Cells(Rows.Count, "H").End(xlUp).Row)
  
    ' Define the range in Sheet15 where you want to store the count
    Set countRange = Sheet15.Range("P1")
  
    ' Define the range in Sheet2 containing week numbers (column G)
    Set weekRange = Sheet2.Range("G1:G" & Sheet2.Cells(Rows.Count, "G").End(xlUp).Row)
  
    ' Clear previous count
    countRange.Value = ""
  
    ' Define the search values (combination of data)
    searchValue1 = "1"
    searchValue2 = "2"
    searchValue3 = "3"
    searchValue4 = Array("3/1/0", "3/2/0")
  
    ' Convert the search range to a variant array for faster processing
    Dim dataArr As Variant
    dataArr = searchRange.Value
  
    ' Convert the week range to a variant array for faster processing
    Dim weekArr As Variant
    weekArr = weekRange.Value
  
    ' Loop through the array to search for the combination of values
    Dim i As Long
    Dim numRows As Long
    Dim foundCount As Long
  
    numRows = UBound(dataArr, 1)
  
    For i = 1 To numRows
        ' Check if each search value is found in the row and the week number matches
        If dataArr(i, 1) = searchValue1 And _
           dataArr(i, 2) = searchValue2 And _
           dataArr(i, 3) = searchValue3 And _
           IsValueInArray(dataArr(i, 7), searchValue4) And _
           GetWeekNumber(dataArr(i, 7)) = GetWeekNumber(dataArr(i, 6)) Then
            foundCount = foundCount + 1
        End If
    Next i
  
    ' Store the count in the count range of Sheet15
    countRange.Value = foundCount
  
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Private Function IsValueInArray(value As Variant, arr As Variant) As Boolean
    ' Helper function to check if value is in array
    Dim i As Long
    For i = LBound(arr) To UBound(arr)
        If value = arr(i) Then
            IsValueInArray = True
            Exit Function
        End If
    Next i
    IsValueInArray = False
End Function

Private Function GetWeekNumber(dateValue As Date) As Long
    ' Helper function to calculate the week number of a date
    GetWeekNumber = WorksheetFunction.WeekNum(dateValue, vbMonday)
End Function

In this code, I added a new variable weekRange to define the range in Sheet2 containing the week numbers (column G). The GetWeekNumber function uses the WeekNum function from the WorksheetFunction object to calculate the week number for a given date.

Inside the loop, I added an additional condition to check if the week number of the date (GetWeekNumber(dataArr(i, 7))) matches the week number of the row (GetWeekNumber(dataArr(i, 6))). If both week numbers match, the row is considered as a match for the combination of values.

Make sure to adjust the ranges and cell references in the code according to your specific workbook structure.
thank you for answering Uncle Gizmo!
But im getting an error on this line "GetWeekNumber(dataArr(i, 7)) = GetWeekNumber(dataArr(i, 6)) Then"
its a ByRef argument type mismatch error
i've been trying to fix it but have been unable to so far..
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 22:53
Joined
Jul 9, 2003
Messages
16,282
Chat GPT Said:-
I apologize for the confusion. The error you're encountering is because the `GetWeekNumber` function expects a `Date` type argument, but the elements in the array `dataArr` are stored as strings. To resolve this issue, you can modify the code to convert the date strings to actual `Date` values before comparing their week numbers. Here's an updated version of the code that includes this modification:

Code:
Sub Button1_Click()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Dim searchRange As Range
    Dim countRange As Range
    Dim count As Long
    Dim searchValue1 As String
    Dim searchValue2 As String
    Dim searchValue3 As String
    Dim searchValue4 As Variant
    Dim weekRange As Range ' Range in Sheet2 containing week numbers
   
    ' Define the search range in Sheet2 where you want to look for the data combination
    Set searchRange = Sheet2.Range("B1:H" & Sheet2.Cells(Rows.Count, "H").End(xlUp).Row)
   
    ' Define the range in Sheet15 where you want to store the count
    Set countRange = Sheet15.Range("P1")
   
    ' Define the range in Sheet2 containing week numbers (column G)
    Set weekRange = Sheet2.Range("G1:G" & Sheet2.Cells(Rows.Count, "G").End(xlUp).Row)
   
    ' Clear previous count
    countRange.Value = ""
   
    ' Define the search values (combination of data)
    searchValue1 = "1"
    searchValue2 = "2"
    searchValue3 = "3"
    searchValue4 = Array("3/1/0", "3/2/0")
   
    ' Convert the search range to a variant array for faster processing
    Dim dataArr As Variant
    dataArr = searchRange.Value
   
    ' Convert the week range to a variant array for faster processing
    Dim weekArr As Variant
    weekArr = weekRange.Value
   
    ' Loop through the array to search for the combination of values
    Dim i As Long
    Dim numRows As Long
    Dim foundCount As Long
   
    numRows = UBound(dataArr, 1)
   
    For i = 1 To numRows
        ' Convert the date strings to actual date values
        Dim dateValue As Date
        dateValue = CDate(dataArr(i, 7))
        Dim rowDate As Date
        rowDate = CDate(dataArr(i, 6))
        
        ' Check if each search value is found in the row and the week number matches
        If dataArr(i, 1) = searchValue1 And _
           dataArr(i, 2) = searchValue2 And _
           dataArr(i, 3) = searchValue3 And _
           IsValueInArray(dataArr(i, 7), searchValue4) And _
           GetWeekNumber(dateValue) = GetWeekNumber(rowDate) Then
            foundCount = foundCount + 1
        End If
    Next i
   
    ' Store the count in the count range of Sheet15
    countRange.Value = foundCount
   
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Private Function IsValueInArray(value As Variant, arr As Variant) As Boolean
    ' Helper function to check if value is in array
    Dim i As Long
    For i = LBound(arr) To UBound(arr)
        If value = arr(i) Then
            IsValueInArray = True
            Exit Function
        End If
   

 Next i
    IsValueInArray = False
End Function

Private Function GetWeekNumber(dateValue As Date) As Long
    ' Helper function to calculate the week number of a date
    GetWeekNumber = WorksheetFunction.WeekNum(dateValue, vbMonday)
End Function

Please give this updated code a try. It should resolve the ByRef argument type mismatch error by converting the date strings to date values using the `CDate` function before comparing their week numbers.
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 22:53
Joined
Jul 9, 2003
Messages
16,282
You can start using chat GPT yourself here's the conversation I've been having with chat GPT about your problem I think you can join it and ask more questions to get your problem sorted out:-

 

goncalo

Member
Local time
Today, 22:53
Joined
May 23, 2023
Messages
51
Ill give it a try and see if it can help me out
if i find the solution ill post it back here in case anyone is in need of a similar thing!
 

Users who are viewing this thread

Top Bottom