Snasui Excel Forum

Code: Select all

Sub comparemps()
Dim i As Integer
Dim pro() As String
Dim cap() As String
Dim procap() As String
Dim no_c As Single

    i = 1
    no_c = 0
    Do Until Worksheets("NEWDATA").Cells(i + 1, 1).Value & Worksheets("NEWDATA").Cells(i + 1, 2).Value = ""
        
        i = i + 1
        no_c = no_c + 1
        
    Loop
ReDim pro(1 To no_c)
ReDim cap(1 To no_c)

i = 1
    For i = 1 To no_c
        
        pro(i) = Worksheets("NEWDATA").Cells(i + 1, 1).Value
        Worksheets("MPS TEMPLATE").Cells(7 + i, 1).Value = pro(i)
        
        cap(i) = Worksheets("NEWDATA").Cells(i + 1, 2).Value
        Worksheets("MPS TEMPLATE").Cells(7 + i, 2).Value = cap(i)
        
    Next i
     
    
   
  
    
    
    
    
    
   
  
End Sub

Code: Select all

Sub comparemps()
Dim i As Integer
Dim pro() As String
Dim cap() As String
Dim procap() As String
Dim no_c As Single

    i = 1
    no_c = 0
    Do Until Worksheets("NEWDATA").Cells(i + 1, 1).Value & Worksheets("NEWDATA").Cells(i + 1, 2).Value = ""
        
        i = i + 1
        no_c = no_c + 1
        
    Loop
ReDim pro(1 To no_c)
ReDim cap(1 To no_c)


i = 1
    For i = 1 To no_c
       pro(i) = Worksheets("NEWDATA").Cells(i + 1, 1).Value
       cap(i) = Worksheets("NEWDATA").Cells(i + 1, 2).Value
     If i = 1 Then
        pro(i) = Worksheets("NEWDATA").Cells(i + 1, 1).Value
        Worksheets("MPS TEMPLATE").Cells(7 + i, 1).Value = pro(i)
        cap(i) = Worksheets("NEWDATA").Cells(i + 1, 2).Value
        Worksheets("MPS TEMPLATE").Cells(7 + i, 2).Value = cap(i)
       
    ElseIf pro(i) = pro(i - 1) Then
    
       pro(i) = Worksheets("NEWDATA").Cells(i + 1, 1).Value
        Worksheets("MPS TEMPLATE").Cells(7 + i, 1).Value = pro(i)
        cap(i) = Worksheets("NEWDATA").Cells(i + 1, 2).Value
        Worksheets("MPS TEMPLATE").Cells(7 + i, 2).Value = cap(i)
       
      
  Else
        
        
        pro(i) = Worksheets("NEWDATA").Cells(i + 1, 1).Value
        Worksheets("MPS TEMPLATE").Cells(7 + i, 1).Value = pro(i)
        cap(i) = Worksheets("NEWDATA").Cells(i + 1, 2).Value
        Worksheets("MPS TEMPLATE").Cells(7 + i, 2).Value = cap(i)
     
     
     End If
    
    Next i
    
    
   
  
    
    
    
    
    
   
  
End Sub

Code: Select all

Dim grandTotal As Double
Sub Test()
    Dim rAll As Range, r As Range
    Dim colR As Collection, item As Variant
    Dim subTotal As Double, target As Range
    Dim iMax As Integer, iCount As Integer
    Set colR = New Collection
    With Sheets("NEWDATA")
        Set rAll = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
    End With
    On Error Resume Next
    For Each r In rAll
        colR.Add r, r
    Next r
    On Error GoTo 0
    For Each item In colR
        iMax = Application.CountIf(rAll, item)
        iCount = 0
        subTotal = 0
        For Each r In rAll
            If r <> "" Then
                With Sheets("MPS TEMPLATE")
                    Set target = .Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
                End With
                If r = item Then
                    target = r
                    target.Offset(0, 1) = r.Offset(0, 1)
                    subTotal = subTotal + r.Offset(0, 1)
                    iCount = iCount + 1
                End If
                If iCount = iMax Then
                    With Sheets("MPS TEMPLATE").Range("a" & Rows.Count).End(xlUp)
                        .Offset(1, 0) = "Sub Total"
                        .Offset(1, 1) = subTotal
                    End With
                    Exit For
                End If
            End If
         Next r
         GrandTotal = GrandTotal + subTotal
    Next item
    With Sheets("MPS TEMPLATE").Range("a" & Rows.Count).End(xlUp)
        .Offset(1, 0) = "Grand Total"
        .Offset(1, 1) = GrandTotal
    End With
    Set colR = Nothing
End Sub