Sum below until blank cell

**TheNxSyS** · 06-01-2009, 10:25 AM

Hello all,

I've included the first three tabs of the worksheet.

You'll notice the Summary-tab in which I would like an summary of all totals per sort. (blue and red rasters). It should be as nice as possible graphically.
Blank rows are welcom to give the document an clear structure.
This way it's easy to consult for people who need only the highlightes.

The last tab should become a non-stop list of all blue rasters.
This will be used to upload in the ERP.
No totals (red rasters) are allowed in the list.

Offcourse, I'm already very glad for all your help.
So don't stress it if it's just the basic you provide me with.
I'll study VBA the coming days so I will be able to do the final tune-up myself.

Best regards,

**DonkeyOte** · 06-01-2009, 12:16 PM

I'm going offline I'm afraid but I will look at this either later this evening my time or tomorrow morning. As for learning VBA in the coming days (!) - good luck with that

... it's taken me years and I'm still learning (but I am quite dense in truth)

**DonkeyOte** · 06-02-2009, 05:33 AM

Below is a routine I just put together to populate the Summary tab - this should give you a starting point from which you can look to a) tweak to your exact requirements and b) base the ERP sheet creation on.

Code:

Public Sub Build_Summary()
Dim ws As Worksheet, wsSummary As Worksheet
Dim xlCalc As XlCalculation
Dim rngData As Range, rngCell As Range
Dim lngCount As Long
On Error GoTo Handler
With Application
    xlCalc = .Calculation
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With
Set wsSummary = Sheets("SUMMARY")
wsSummary.UsedRange.Offset(1).ClearContents
For Each ws In ThisWorkbook.Worksheets
    Select Case UCase(ws.Name)
        Case "SUMMARY", "UPLOAD ERP"
            'do nothing
        Case Else
            lngCount = 0
            Set rngData = ws.Columns(1).SpecialCells(xlCellTypeConstants, xlTextValues)
            With wsSummary
                'header
                .Cells(Rows.Count, "A").End(xlUp).Offset(2).Value = UCase(ws.Name) & " FAMILY"
                For Each rngCell In rngData.Cells
                    With .Cells(Rows.Count, "A").End(xlUp).Offset(1 + Abs(lngCount <= 1))
                        'A
                        .Value = rngCell.Value
                        'I & J
                        .Offset(, 1).Resize(, 2).Value = rngCell.Offset(, 8).Resize(, 2).Value
                        'M & N
                        .Offset(, 3).Resize(, 2).Value = rngCell.Offset(, 12).Resize(, 2).Value
                    End With
                    lngCount = lngCount + 1
                Next rngCell
            End With
            Set rngData = Nothing
    End Select
Next ws

ExitPoint:
Set wsSummary = Nothing
With Application
    .ScreenUpdating = True
    .Calculation = xlCalc
    .EnableEvents = True
End With

Exit Sub

Handler:
MsgBox "Error Has Occurred" & vbLf & vbLf & _
        "Error Number: " & Err.Number & vbLf & vbLf & _
        "Error Desc.: " & Err.Description, _
        vbCritical, _
        "Fatal Error"
Resume ExitPoint

End Sub

**TheNxSyS** · 06-03-2009, 03:49 AM

Hi, looks great and I'm going along with the code.

However I can't re-write your summary-code for the ERP-code.
I need the code that the program for the ERP-tab can only start to look from row 4.
Can you please give me the short piece so I can overwrite the summery code with it.

Kr,

**TheNxSyS** · 06-08-2009, 05:53 AM

Hello all,

I've included my most recent version of the stock-document.
I've got 2 main issues:

1- Regarding sheet ATX
You'll see that I've marked cell A14 with 'stop' in the sheet ATX.
This is because if I don't do this VBA totally scrambles up the sheet.
It seems the program has a problem when there is only one product on the sheet.

Can somebody please help me to solve this ?

2- Regarding sheet ERP
Basically it's the same program as the summary-one.
But I can't program the ERP-update in order that it only begins on the 5th row to look for cells that aren't empty. That way, the total of each sheet isn't copied to the ERP-sheet.

Can somebody please help me to solve this ?

Many thanks in advance!

**DonkeyOte** · 06-08-2009, 05:56 AM

Your post does not comply with Rule 6 of our Forum RULES. Common courtesy is the order of the day. Avoid coarse language, provide feedback to suggested solutions, and take the time to thank those who took their time to help you.

Asterisks or not, unacceptable language - please edit your last post as a matter of priority.

**TheNxSyS** · 06-08-2009, 06:43 AM

I'm sorry for my language !
I've replaced the word.

**DonkeyOte** · 06-08-2009, 08:38 AM

Re: point 1 (Summary Sheet Failure with one Product on Source sheet)
I ran the code I provided on post # 18 on your latest file and having removed the STOP line on ATX sheet the code populated the SUMMARY tab without incident.
Given you didn't provide the code you used in your own version it's hard to say what may have caused the issue you made reference to but to reiterate the original code worked for me without issue.

Re: point 2 (ERP Sheet)
The basic premise (I thought) was that you were going to learn VBA so I had expected you would want to at least have a go at modifying the code provide thus far such that you could use a similar process to update the ERP sheet, is this no longer the case ? It would be good to have a quick go yourself (IMO).

That said I am a little confused re: the ERP output - originally I was under the impression that you just wanted to list the red bordered entries ? Your last file would imply otherwise (ie seems to replicate the Summary tab)

**TheNxSyS** · 06-08-2009, 11:38 AM

Hello,

Yes I'm forgot the code indeed, and more importantly, yes I'm currently looking into VBA.

First I had a go in making the subtotals automated.
You've provided the subtotal-programming for column C for 1 sheet.
I've made the rest with some studying myself.
I'm quite happy with the result, apart from the hick-up in the ATX-sheet.

However, I can't figure out your range-setting of the summary-program.
If you think it's best I take another go at it, I'll sure do, but please help me with the ATX-problem as this is my 'own' (copied) code and I don't see the cause.

Code:

Private Sub CommandButton1_Click()
    Call Update_SubTotals
    UpdateCenter.Hide
End Sub

Private Sub CommandButton2_Click()
    Call Build_Summary
    UpdateCenter.Hide
End Sub

Private Sub CommandButton3_Click()
    Call Build_ERP
    UpdateCenter.Hide
End Sub

Private Sub CommandButton4_Click()
    Call Update_SubTotals
    Call Build_Summary
    Call Build_ERP
    UpdateCenter.Hide
End Sub

Public Sub Update_SubTotals()
Dim ws As Worksheet
Dim rngData As Range, rngCell As Range

For Each ws In ThisWorkbook.Worksheets
    ws.Activate
    Select Case UCase(ws.Name)
        Case "SUMMARY", "UPLOAD ERP"
            'do nothing
        Case Else
            With Range(Cells(5, "A"), Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues).Offset(, 5)
                .FormulaR1C1 = "=SUM(R[1]C6:INDEX(R[1]C6:R1000C6,MATCH(TRUE,INDEX(R[1]C6:R1000C6="""",0),0)))"
            End With
            
            With Range(Cells(5, "A"), Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues).Offset(, 8)
                .FormulaR1C1 = "=SUM(R[1]C9:INDEX(R[1]C9:R1000C9,MATCH(TRUE,INDEX(R[1]C9:R1000C9="""",0),0)))"
            End With
            
            With Range(Cells(5, "A"), Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues).Offset(, 9)
                .FormulaR1C1 = "=SUM(R[1]C10:INDEX(R[1]C10:R1000C10,MATCH(TRUE,INDEX(R[1]C10:R1000C10="""",0),0)))"
            End With
                                    
            With Range(Cells(5, "A"), Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues).Offset(, 12)
                .FormulaR1C1 = "=R[0]C14/R[0]C10"
            End With
            
            With Range(Cells(5, "A"), Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues).Offset(, 13)
                .FormulaR1C1 = "=SUM(R[1]C14:INDEX(R[1]C14:R1000C14,MATCH(TRUE,INDEX(R[1]C14:R1000C14="""",0),0)))"
            End With
    End Select
Next ws

End Sub

Public Sub Build_Summary()
Dim ws As Worksheet, wsSummary As Worksheet
Dim xlCalc As XlCalculation
Dim rngData As Range, rngCell As Range
Dim lngCount As Long
On Error GoTo Handler

With Application
    xlCalc = .Calculation
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With

Set wsSummary = Sheets("SUMMARY")
wsSummary.UsedRange.Offset(1).ClearContents
For Each ws In ThisWorkbook.Worksheets
    Select Case UCase(ws.Name)
        Case "SUMMARY", "UPLOAD ERP"
            'do nothing
        Case Else
            lngCount = 0
            Set rngData = ws.Columns(1).SpecialCells(xlCellTypeConstants, xlTextValues)
            With wsSummary
                'header
                ' .Cells(Rows.Count, "A").End(xlUp).Offset(2).Value = UCase(ws.Name) & " Tabblad"
                For Each rngCell In rngData.Cells
                    With .Cells(Rows.Count, "A").End(xlUp).Offset(1 + Abs(lngCount <= 1))
                        'A
                        .Value = rngCell.Value
                        'I & J
                        .Offset(, 1).Resize(, 2).Value = rngCell.Offset(, 8).Resize(, 2).Value
                        'M & N
                        .Offset(, 3).Resize(, 2).Value = rngCell.Offset(, 12).Resize(, 2).Value
                    End With
                    lngCount = lngCount + 2
                Next rngCell
            End With
            Set rngData = Nothing
    End Select
Next ws

ExitPoint:
Set wsSummary = Nothing
With Application
    .ScreenUpdating = False
    .Calculation = xlCalc
    .EnableEvents = True
End With

Exit Sub

Handler:
MsgBox "Error Has Occurred" & vbLf & vbLf & _
        "Error Number: " & Err.Number & vbLf & vbLf & _
        "Error Desc.: " & Err.Description, _
        vbCritical, _
        "Fatal Error"
Resume ExitPoint

End Sub

Public Sub Build_ERP()
Dim ws As Worksheet, wsSummary As Worksheet
Dim xlCalc As XlCalculation
Dim rngData As Range, rngCell As Range
Dim lngCount As Long
On Error GoTo Handler
With Application
    xlCalc = .Calculation
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With
Set wsSummary = Sheets("UPLOAD ERP")
wsSummary.UsedRange.Offset(1).ClearContents
For Each ws In ThisWorkbook.Worksheets
    Select Case UCase(ws.Name)
        Case "SUMMARY", "UPLOAD ERP"
            'do nothing
        Case Else
            lngCount = 0
            Set rngData = ws.Columns(1).SpecialCells(xlCellTypeConstants, xlTextValues)
            With wsSummary
                'header
                ' .Cells(Rows.Count, "A").End(xlUp).Offset(2).Value = UCase(ws.Name) & " Tabblad"
                For Each rngCell In rngData.Cells
                    With .Cells(Rows.Count, "A").End(xlUp).Offset(1 + Abs(lngCount <= 1))
                        'A
                        .Value = rngCell.Value
                        'M
                        .Offset(, 1).Value = rngCell.Offset(, 12)
                    End With
                    lngCount = lngCount + 2
                Next rngCell
            End With
            Set rngData = Nothing
    End Select
Next ws

ExitPoint:
Set wsSummary = Nothing
With Application
    .ScreenUpdating = False
    .Calculation = xlCalc
    .EnableEvents = True
End With

Exit Sub

Handler:
MsgBox "Error Has Occurred" & vbLf & vbLf & _
        "Error Number: " & Err.Number & vbLf & vbLf & _
        "Error Desc.: " & Err.Description, _
        vbCritical, _
        "Fatal Error"
Resume ExitPoint

End Sub

**DonkeyOte** · 06-09-2009, 09:08 AM

I just ran your code re: Summary sheet having remove the STOP on the ATX sheet and again it ran without issue as before which makes sense given the only change is the commenting out of the Family header.

I'm still unclear as to what you intend to populate the ERP sheet with...
Post a sample with desired results based on the source sheets.