runtime error 6 overflow, macro to create table

[atditiljazi]

hello, below is a macro i created that doesn't seem to work. i get a "runtime error 6 overflow" message. can someone figure out why i am getting the message by looking at the macro?

Sub CreateSummaryTable()
    Dim ws2 As Worksheet, ws1 As Worksheet
    Dim lastRow As Long, supplierRow As Long, summaryRow As Long
    Dim supplier As String
    Dim onTimeCount As Long, lateCount As Long
    Dim onTimePercent As Double, latePercent As Double

    ' Set worksheets
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws1 = ThisWorkbook.Sheets("Sheet3")

    ' Determine the last row with data in Column A of Sheet2
    lastRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

    ' Loop through each supplier in Column A of Sheet2
    For supplierRow = 2 To lastRow ' Assuming header row is in Row 1

        ' Get the supplier name
        supplier = ws2.Cells(supplierRow, "A").Value

        ' Reset the counters
        onTimeCount = 0
        lateCount = 0

        ' Loop through each row in Column E (Delivery Status) of Sheet2
        For Each cell In ws2.Range("F2:F" & lastRow)
            ' Check if the supplier name matches
            If cell.Offset(0, -4).Value = supplier Then
                ' Count the "on time" and "late" deliveries
                If cell.Value = "On Time" Then
                    onTimeCount = onTimeCount + 1
                ElseIf cell.Value = "Late" Then
                    lateCount = lateCount + 1
                End If
            End If
        Next cell

        ' Calculate the percentages
        onTimePercent = (onTimeCount / (onTimeCount + lateCount)) * 100
        latePercent = (lateCount / (onTimeCount + lateCount)) * 100

        ' Find the first empty row in Column A of Sheet1
        summaryRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row + 1

        ' Write the supplier name and percentages to Sheet1
        ws1.Cells(summaryRow, "A").Value = supplier
        ws1.Cells(summaryRow, "B").Value = onTimePercent
        ws1.Cells(summaryRow, "C").Value = latePercent

        ' Update the progress
        DoEvents
    Next supplierRow

    ' Clear any previous data in Sheet1 starting from row 2
    ws1.Range("A2:C" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row).ClearContents

    ' Display a message when finished
    MsgBox "Summary table created successfully."
End Sub

 

[Joe4]

See here: VBA Overflow Error (Error 6).

Do you get that message when compiling or trying to run the code?
Do you get a "Debug" button option?
If so, click and see what line of code it highlights. That it telling you where it is erroring out.

 

[atditiljazi]

i get the message when trying to run the code. i do not get a debug option

 

[atditiljazi]

See here: VBA Overflow Error (Error 6).

Do you get that message when compiling or trying to run the code?
Do you get a "Debug" button option?
If so, click and see what line of code it highlights. That it telling you where it is erroring out.

i get the message when trying to run the code. i do not get a debug option

 

[DanteAmor]

The problem is when it doesn't find data with values: "On Time" or "Late".

Try:

Sub CreateSummaryTable()
    Dim ws2 As Worksheet, ws1 As Worksheet
    Dim lastRow As Long, supplierRow As Long, summaryRow As Long
    Dim supplier As String
    Dim onTimeCount As Long, lateCount As Long
    Dim onTimePercent As Double, latePercent As Double
    
    Dim cell As Range

    ' Set worksheets
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws1 = ThisWorkbook.Sheets("Sheet3")

    ' Determine the last row with data in Column A of Sheet2
    lastRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

    ' Loop through each supplier in Column A of Sheet2
    For supplierRow = 2 To lastRow ' Assuming header row is in Row 1

        ' Get the supplier name
        supplier = ws2.Cells(supplierRow, "A").Value

        ' Reset the counters
        onTimeCount = 0
        lateCount = 0

        ' Loop through each row in Column E (Delivery Status) of Sheet2
        For Each cell In ws2.Range("F2:F" & lastRow)
            ' Check if the supplier name matches
            If cell.Offset(0, -4).Value = supplier Then
                ' Count the "on time" and "late" deliveries
                If cell.Value = "On Time" Then
                    onTimeCount = onTimeCount + 1
                ElseIf cell.Value = "Late" Then
                    lateCount = lateCount + 1
                End If
            End If
        Next cell

        ' Calculate the percentages
        onTimePercent = 0
        latePercent = 0
        
        If onTimeCount > 0 Or lateCount > 0 Then
          onTimePercent = (onTimeCount / (onTimeCount + lateCount)) * 100
          latePercent = (lateCount / (onTimeCount + lateCount)) * 100
        End If
        
        ' Find the first empty row in Column A of Sheet1
        summaryRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row + 1

        ' Write the supplier name and percentages to Sheet1
        ws1.Cells(summaryRow, "A").Value = supplier
        ws1.Cells(summaryRow, "B").Value = onTimePercent
        ws1.Cells(summaryRow, "C").Value = latePercent

        ' Update the progress
        DoEvents
    Next supplierRow

    ' Clear any previous data in Sheet1 starting from row 2
    'ws1.Range("A2:C" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row).ClearContents

    ' Display a message when finished
    MsgBox "Summary table created successfully."
End Sub

 

[DanteAmor]

I added a condition to not divide by 0 so that it doesn't raise the error.

        ' Calculate the percentages
        onTimePercent = 0
        latePercent = 0
        
        If onTimeCount > 0 Or lateCount > 0 Then
          onTimePercent = (onTimeCount / (onTimeCount + lateCount)) * 100
          latePercent = (lateCount / (onTimeCount + lateCount)) * 100
        End If

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

 

[atditiljazi]

The problem is when it doesn't find data with values: "On Time" or "Late".

Try:

Sub CreateSummaryTable()
    Dim ws2 As Worksheet, ws1 As Worksheet
    Dim lastRow As Long, supplierRow As Long, summaryRow As Long
    Dim supplier As String
    Dim onTimeCount As Long, lateCount As Long
    Dim onTimePercent As Double, latePercent As Double
   
    Dim cell As Range

    ' Set worksheets
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws1 = ThisWorkbook.Sheets("Sheet3")

    ' Determine the last row with data in Column A of Sheet2
    lastRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

    ' Loop through each supplier in Column A of Sheet2
    For supplierRow = 2 To lastRow ' Assuming header row is in Row 1

        ' Get the supplier name
        supplier = ws2.Cells(supplierRow, "A").Value

        ' Reset the counters
        onTimeCount = 0
        lateCount = 0

        ' Loop through each row in Column E (Delivery Status) of Sheet2
        For Each cell In ws2.Range("F2:F" & lastRow)
            ' Check if the supplier name matches
            If cell.Offset(0, -4).Value = supplier Then
                ' Count the "on time" and "late" deliveries
                If cell.Value = "On Time" Then
                    onTimeCount = onTimeCount + 1
                ElseIf cell.Value = "Late" Then
                    lateCount = lateCount + 1
                End If
            End If
        Next cell

        ' Calculate the percentages
        onTimePercent = 0
        latePercent = 0
       
        If onTimeCount > 0 Or lateCount > 0 Then
          onTimePercent = (onTimeCount / (onTimeCount + lateCount)) * 100
          latePercent = (lateCount / (onTimeCount + lateCount)) * 100
        End If
       
        ' Find the first empty row in Column A of Sheet1
        summaryRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row + 1

        ' Write the supplier name and percentages to Sheet1
        ws1.Cells(summaryRow, "A").Value = supplier
        ws1.Cells(summaryRow, "B").Value = onTimePercent
        ws1.Cells(summaryRow, "C").Value = latePercent

        ' Update the progress
        DoEvents
    Next supplierRow

    ' Clear any previous data in Sheet1 starting from row 2
    'ws1.Range("A2:C" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row).ClearContents

    ' Display a message when finished
    MsgBox "Summary table created successfully."
End Sub

hi,

eventually fixed it by running the following macro.

What I'm having trouble with now is not having multiple rows of the same supplier. For example, I have supplier "a" in 10 rows, supplier "b" in 6 rows, etc, and when I run the macro, I get 10 rows followed by the "ontime" and "late" percentages for supplier "a" and 6 rows for supplier "b" and so on.

I'd like the macro to insert one supplier per row.

Sub CreateSupplierTable()
    Dim sht2 As Worksheet, sht3 As Worksheet
    Dim lastRow As Long, i As Long
    Dim supplier As String, onTimeCount As Long, lateCount As Long, totalCount As Long

    ' Set the worksheets
    Set sht2 = ThisWorkbook.Sheets("Sheet2")
    Set sht3 = ThisWorkbook.Sheets("Sheet3")

    ' Clear existing data in Sheet3
    sht3.Cells.Clear

    ' Find the last row in Sheet2 column A
    lastRow = sht2.Cells(sht2.Rows.Count, "A").End(xlUp).Row

    ' Initialize row number in Sheet3
    rowNum = 2

    ' Loop through each supplier in column A of Sheet2
    For i = 2 To lastRow
        supplier = sht2.Range("A" & i).Value

        ' Initialize counters
        onTimeCount = 0
        lateCount = 0
        totalCount = 0

        ' Loop through column F of Sheet2 to count on time and late occurrences for the current supplier
        For Each cell In sht2.Range("F2:F" & lastRow)
            If cell.Offset(0, -5).Value = supplier Then
                totalCount = totalCount + 1
                If cell.Value = "On Time" Then
                    onTimeCount = onTimeCount + 1
                ElseIf cell.Value = "Late" Then
                    lateCount = lateCount + 1
                End If
            End If
        Next cell

        ' Calculate percentages
        onTimePercentage = Round(onTimeCount / totalCount * 100, 2)
        latePercentage = Round(lateCount / totalCount * 100, 2)

        ' Write the supplier and percentages in Sheet3
        sht3.Range("A" & rowNum).Value = supplier
        sht3.Range("B" & rowNum).Value = onTimePercentage & "%"
        sht3.Range("C" & rowNum).Value = latePercentage & "%"

        ' Move to the next row in Sheet3
        rowNum = rowNum + 1
    Next i

    ' Autofit columns in Sheet3
    sht3.Columns("A:C").AutoFit

    MsgBox "Supplier table created successfully!"

End Sub

 

[DanteAmor]

Apparently your macro is created with artificial intelligence.

The correct thing is that you provide a description of what you need to do.

An example of your data that you have on sheet2 and an example of what you expect as a result.

If you don't provide examples we will only be guessing and in the end you are not following my recommendations

 

[atditiljazi]

Apparently your macro is created with artificial intelligence.

The correct thing is that you provide a description of what you need to do.

An example of your data that you have on sheet2 and an example of what you expect as a result.

If you don't provide examples we will only be guessing and in the end you are not following my recommendations

yes, the macro was created by A.I . i am in the middle of creating an OTIF spreadsheet

screenshot of sheet 2 and sheet 1 below.

i would like a table in sheet 1 showing the "ontime" and "late" percentages per supplier which is under column a "name" from sheet 2