Question: Using variables to define rows.

[neddiexyz]

Using a macro I have imported data into a blank worksheet from cell A8. Basically column A contains a part No and column E it's quantity amount.
something like:

12345 57
31
12346 190
12347 12

The aprt No only appaers when it changes. Because the 2nd row above is blank I know that the part no is the same as the one above.
What I now need to do is insert a blank row to seperate each part no (this I have already done, and now sum the quantities relavent to that part no. With reference to row 1 above that would be: 57 + 31 = 88. I need to repeat this until I reach the last row of my sheet. Oh!, I have marded thsi with "END" which I am testing for in my loop. Can anyone point me in the right direction as to how this can be done.

Thanks in advance.

Ned.

 

[sijpie]

The first partnumber is in cell A8. So let's anchor ourselves there.
We'll use RCnt for keeping track of our rows.

dim RCnt as Long, PartSum as Long
dim PrtNo as String
dim A as range
 
set A = Range("A8")
 
Do While A.Offset(RCnt,0).value <> "END"
 
    'while cell Ax not 'END'
   if A.Offset(RCnt,4).value then
        PartSum = PartSum + A.Offset(RCnt,4).value 
   else
        A.Offset(RCnt,4).value = PartSum
        ' write sum in empty line
        PartSum = 0
   end if
   RCnt = RCnt +1
Loop

 

[neddiexyz]

A B C D E
111509 210390 5A35 SPAR FIG ROLL 875
115170 207601 6F43 CADBURY FINGERS 57
207606 6G21 CADBURY FINGERS 57
207608 6E35 CADBURY FINGERS 57
207620 6A05 CADBURY FINGERS 57
207622 6G09 CADBURY FINGERS 57
207626 6F22 CADBURY FINGERS 57
207628 6B04 CADBURY FINGERS 57
208922 6K28 CADBURY FINGERS 57
208923 6K28 CADBURY FINGERS 57
208924 6J17 CADBURY FINGERS 57
208926 6D18 CADBURY FINGERS 57
116950 206679 6J/K *******S 700
118071 206633 6D12 *******S 550

Hi sijpie,
Firstly, Thank you for your prompt response.
Please see above sample of the imported data.
Columns A to E.
Column A contains the Part No.
What I think I need is :
2 x counters RCnt1 & RCnt2
If we start at the top, PartNo 111509 is in A8.
So RCnt1 = 8 (fixed)
RCnt2 will be my running counter.
In the above example because the next PartNo is
115170, I need to insert a blank line and then use
RCnt1 and RCnt2 to define the range of my SUM formula.i.e Row 8 to 9.
RCnt2 would be = 9
This is where I am getting stuck.Using RCnt1 and RCnt2 in the SUM Formula.
If we used the next PartNo 115170. Because all row underneath this until 116950 are blank I know that these are all = 115170
So RCnt1 = 10 (fixed)
RCnt2 = 21 (point at which PartNo changes). I now need to SUM this as =SUM(RCnt1 : & RCnt2) (This is where
I am having theproblem with the correct formula.)
Any further input would be greatly appreciated.
Thanks
Kind regards
Ned.

 

[sijpie]

Ned,

in your first post you mentioned you had already inserted the blank rows. I thought you meant physically, so my macro just checked for a blank row and then inserted the sum right there (not as formula but as value).

Do you need the sum as a formula? Why not the value. I am assuming you pull the data from some database occasionaly and then run this macor, so you are not going to add any rows or change the numbers. in which case we can just write down the sum we keep track of in the macro (PartSum).

I have amended the macro so that now it will first add a blank row and pop this sum for that part number in place.

Option Explicit
Sub InsertSum()
    Dim RCnt As Long, PartSum As Long
    Dim PrtNo As String
    Dim A As Range
 
    Set A = Range("A8")
 
    Do While A.Offset(RCnt, 1).Value <> vbNullString
        'while cell Bx not empty
 
        PartSum = PartSum + A.Offset(RCnt, 4).Value
        If A.Offset(RCnt + 1, 0).Value Or (PartSum And A.Offset(RCnt + 1, 1) = vbNullString) Then
            ' insert two rows and add total for item in column E
            ' if next row starts with part number or last line
            A.Offset(RCnt + 1, 0).EntireRow.Insert
            'enter sum and make bold
            With A.Offset(RCnt + 1, 4)
                .Value = PartSum
                .Font.Bold = True
            End With
            PartSum = 0
            'underline last cell of group
            With A.Offset(RCnt, 4).Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            ' add additional empty line
            A.Offset(RCnt + 2, 0).EntireRow.Insert
            RCnt = RCnt + 2
'        Else
'            A.Offset(RCnt, 4).Value = PartSum
            ' write sum in empty line
        End If
        RCnt = RCnt + 1
    Loop
 
    Set A = Nothing
End Sub

Put this macro in a module and it should run fine. See the comments in the macro to understand what it does.
You don't need to add 'END' at the end either. it will figure it out.

It worked fine on your example data

 

[neddiexyz]

Ned,

in your first post you mentioned you had already inserted the blank rows. I thought you meant physically, so my macro just checked for a blank row and then inserted the sum right there (not as formula but as value).

Do you need the sum as a formula? Why not the value. I am assuming you pull the data from some database occasionaly and then run this macor, so you are not going to add any rows or change the numbers. in which case we can just write down the sum we keep track of in the macro (PartSum).

I have amended the macro so that now it will first add a blank row and pop this sum for that part number in place.

Option Explicit
Sub InsertSum()
    Dim RCnt As Long, PartSum As Long
    Dim PrtNo As String
    Dim A As Range
 
    Set A = Range("A8")
 
    Do While A.Offset(RCnt, 1).Value <> vbNullString
        'while cell Bx not empty
 
        PartSum = PartSum + A.Offset(RCnt, 4).Value
        If A.Offset(RCnt + 1, 0).Value Or (PartSum And A.Offset(RCnt + 1, 1) = vbNullString) Then
            ' insert two rows and add total for item in column E
            ' if next row starts with part number or last line
            A.Offset(RCnt + 1, 0).EntireRow.Insert
            'enter sum and make bold
            With A.Offset(RCnt + 1, 4)
                .Value = PartSum
                .Font.Bold = True
            End With
            PartSum = 0
            'underline last cell of group
            With A.Offset(RCnt, 4).Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            ' add additional empty line
            A.Offset(RCnt + 2, 0).EntireRow.Insert
            RCnt = RCnt + 2
'        Else
'            A.Offset(RCnt, 4).Value = PartSum
            ' write sum in empty line
        End If
        RCnt = RCnt + 1
    Loop
 
    Set A = Nothing
End Sub

Put this macro in a module and it should run fine. See the comments in the macro to understand what it does.
You don't need to add 'END' at the end either. it will figure it out.

It worked fine on your example data

Hi sijpie,
Once again , Thank you for your prompt response. I will try your code out and let you know.

Kind regards,

Ned

 

[neddiexyz]

Hi sijpie,
Once again , Thank you for your prompt response. I will try your code out and let you know.

Kind regards,

Ned

Hi sijpie,

Tested your code worked GREAT! Thanks again for taking the time and effort to help.

Kind regards

Ned