Pulling my hair out on this macro

[edrobyn]

Hello,

I have a simple macro that I am trying to create. I haven't done programming in Basic in several years but I used to could do a nested loop to perform multiple repeats. Anyway, I have a small spreedsheet that has two rows of numbers. In column "A" are numbers that repeat for several rows and in column "C" are corresponding numbers that are associated with those in column "A". I am trying to write a macro that will add the numbers in column "C" until the numbers in column "A" stop repeating, post those numbers on a separate sheet, then go back to the original sheet and pick up where it left off. The output would be the sum of the numbers in column "C" plus the count of the numbers that repeat in column "A". I can program to do this one time and can not get it to pick up where it left off to add the reamining numbers. Once the numbers in column "A" stop repeating I need the program to continue with the next set of numbers until there are no more numbers.


The data looks something like this:


Column "A" Column "C"
1................... 43
1 ...................36
1 ...................14
1 .....................8
1 ....................34
1 ....................23
2 ...................15
2 ...................12
2.................... 12
2.................... 89

the output would look something like
#.....................sum of #
5.................... 158
4 ....................128

I need the macro to continue until it there no more numbers in column "A".

I can get it to work for the "1's but can not get it to go back and start with the 2's.



This is my program so far:

Sub CountRows()
x = 3
y = 3
(the data starts in row 3 and has a header that I want to skip)
Do While Cells(x, 3).Value <> ""


Do While Cells(x, 3).Value <> ""


If Cells(x, 3).Value = Cells(x + 1, 3).Value Then z = z + 1 Else GoTo 1
total = total + Cells(x, y + 2).Value

x = x + 1

Loop
1 total = total + Cells(x, y + 2).Value
z = z + 1
K = 0
Sheets("sheet1").Select
Cells(K + 1, 1).Value = z
Cells(K + 2, 1).Value = total
Sheets("Names").Select
Loop
End Sub


What can I do to get it to repeat with the next set of numbers?

Thanks alot.

 

[AlphaFrog]

What version of Excel do you have?

 

[edrobyn]

2003

 

[AlphaFrog]

I assumed that this "Collered Sensor Tee" is a typo in your example data set.

Sub CountRows()
    
    Dim wsData As Worksheet, wsResult As Worksheet, rng As Range
    Dim Lastrow As Long, criteria As Variant
    Dim strRngA As String, strRngB As String, strRngC As String
    
    Set wsData = Sheets("Names")
    Set wsResult = Sheets("Sheet1")
    
    Application.ScreenUpdating = False
    
    'Clear old data
    With wsResult
        .Columns("A:I").ClearContents
        .Range("A1:I1").Value = Array("User ID", "Total Cases", "Total Units", "Coll[COLOR="Red"]a[/COLOR]red Sensor", "Collar", "Side Sensored", "Remove Plastic", "Apply Tickets", "Safers")
    End With
    
    'Unique numbers list
    With wsData
        Set rng = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
        rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
        rng.Offset(1).SpecialCells(xlCellTypeVisible).Copy Destination:=wsResult.Range("A2")
        .ShowAllData
    End With
    
    'Counts and totals
    With wsResult
        Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("B2:B" & Lastrow).FormulaR1C1 = "=COUNTIF('" & wsData.Name & "'!C1, RC1)"
        .Range("C2:C" & Lastrow).FormulaR1C1 = "=SUMIF('" & wsData.Name & "'!C1, RC1, '" & wsData.Name & "'!C3)"
                
        strRngA = "'" & wsData.Name & "'!" & rng.Address(, , xlR1C1)
        strRngB = "'" & wsData.Name & "'!" & rng.Offset(, 1).Address(, , xlR1C1)
        strRngC = "'" & wsData.Name & "'!" & rng.Offset(, 2).Address(, , xlR1C1)
        criteria = Array("Coll[COLOR="Red"]a[/COLOR]red Sensor Tee", "Collar", "Side Sensored Ts", "Remove Plastic", "Apply Tickets", "Safers")
        For i = 0 To UBound(criteria)
            .Range("D2:D" & Lastrow).Offset(, i).FormulaR1C1 = "=SUMPRODUCT(--(" & strRngA & "=RC1),--(" & strRngB & _
                                                               "=""" & criteria(i) & """)," & strRngC & ")"
        Next i
        
        .Range("A2:I" & Lastrow).Value = .Range("A2:I" & Lastrow).Value
        .Range("A2:I" & Lastrow).Replace 0, "", xlWhole
        .Range("A:I").Columns.AutoFit
        
    End With
    
    Application.ScreenUpdating = True
    
End Sub

 

[taurean]

The other day, I tried my hand at Pivot Table through VBA (on the other one, VBAEXPRESS). It was hair pulling experience (it was even more so when I learnt them for the first time and it was without VBA). I guess requirement can be handled by Pivot Tables as has been suggested by 'Norie'. Here's the code:

Public Sub CreateReport()
Dim pCache As PivotCache
Dim pTable As PivotTable
Dim lLastRow As Long
Dim ws As Worksheet
Set ws = Sheet1
With ws
lLastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set pCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, .Range("A1:C" & lLastRow))

Set pTable = pCache.CreatePivotTable(Sheet2.Range("A" & Rows.Count).End(xlUp)(4), _
"Report No." & ws.Name, True)
    
    With pTable
        
        'To get old format for rearranging the info
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
        .ColumnGrand = False
        .RowGrand = False
        
        'Adding the first field at pos 1
        With .PivotFields("USER_ID")
        .Orientation = xlRowField
        .Position = 1
        End With
        
        'Adding the second field at pos 2
        With .PivotFields("VAS_ACTIVITY")
        .Orientation = xlColumnField
        End With
        
        'Adding sum of the data
        .AddDataField .PivotFields("VAS_QTY"), "Sum of VAS_QTY", xlSum
              
    End With
    
End With
End Sub

You may have to tweak it some as I have prepared this code in Excel 2007.

 

[edrobyn]

Thanks Alpha that works awesome! If I could ask for one more piece of advice. The numbers in column A and C are downloaded from a database as a text and I wrote a small macro to convert them to a number so that they can be sorted. This is what I did but I would think there has to be a better way. Once again I would like for this to occur in the macro for ease of the user. This is what I have:


For numbers in column A
Cells(2, 1).Select
x = 2
y = 1

Do While Cells(x, y).Value <> ""
Cells(x, y + 1).Select

ActiveCell.FormulaR1C1 = "=SUMPRODUCT((RC[-1])*1)"

Selection.Copy
Cells(x + 1, y + 1).Select
ActiveSheet.Paste

x = x + 1
Loop

For numbers in column C

Cells(2, 1).Select

x = 2
y = 2

Do While Cells(x, y).Value <> ""
Cells(x, y + 1).Select

ActiveCell.FormulaR1C1 = "=SUMPRODUCT((RC[-1])*1)"

Selection.Copy
Cells(x + 1, y + 1).Select
ActiveSheet.Paste

x = x + 1




Loop

It doesn't appear to be a very efficient way to do this. Do you have a better suggestion?

 

[AlphaFrog]

Give this a try. It may or may not work depending on the nature of your data.

    Range("A:A, C:C").NumberFormat = "General"
    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
                                 FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
    Columns("C:C").TextToColumns Destination:=Range("C1"), DataType:=xlFixedWidth, _
                                 FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True

 

[edrobyn]

Yup, that worked also. You are amazing! I can't thank you enough for your help. If I happen to get cudos for this macro I will be sure to let the powers to be know that I help from this forum. Although, I am not sure if they would believe me if they ask who helped me and I told them Alphafrog!!

Thanks again!

 

[AlphaFrog]

You're welcome. It's all about saving the hair.

 

[edrobyn]

And if you are like me there is not much to save!