Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations John Tel on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Problem in VBA code for excel

Status
Not open for further replies.
thomasks

thomasks

Programmer
May 12, 2006
113
US
I have some code in VBA that totals the cells on different worksheets, and adds them to a new sheet called "Totals".
But there is a problem in that all the sheets are not being totalled. Could someone take a look at this code and maybe see the problem with it?
Code: 
Public Sub cmdTotal()
Dim oSheet As Worksheet
Dim oWorkbook As Workbook
Dim iRow As Integer
Dim WriteRow As Integer
Dim iTotalRow As Integer
Dim cCL100 As Integer
Dim cCL200 As Integer
Dim cCL200_75 As Integer
Dim cCL2001 As Integer
Dim cCL2002 As Integer
Dim cCL2003 As Integer
Dim cCL2005 As Integer
Dim cCL2007_5 As Integer
Dim cCL20010 As Integer
Dim cCL100Total As Integer
Dim cCL200Total As Integer
Dim cCL200_75Total As Integer
Dim cCL2001Total As Integer
Dim cCL2002Total As Integer
Dim cCL2003Total As Integer
Dim cCL2005Total As Integer
Dim cCL2007_5Total As Integer
Dim cCL20010Total As Integer
Dim strRange As String
Dim r As Long, c As Long

Set oWorkbook = ActiveWorkbook


             cCL100 = 0
             cCL200 = 0
             cCL200_75 = 0
             cCL2001 = 0
             cCL2002 = 0
             cCL2003 = 0
             cCL2005 = 0
             cCL2007_5 = 0
             cCL20010 = 0
             cCL100Total = 0
             cCL200Total = 0
             cCL200_75Total = 0
             cCL2001Total = 0
             cCL2002Total = 0
             cCL2003Total = 0
             cCL2005Total = 0
             cCL2007_5Total = 0
             cCL20010Total = 0
            
            

Set oSheet = ActiveSheet
Worksheets.Add

ActiveSheet.Name = "Totals"
Sheets("Totals").Select
ActiveWorkbook.Sheets("Totals").Tab.ColorIndex = 4
ActiveWorkbook.Sheets("Totals").Select
ActiveWorkbook.Sheets("Totals").Move After:=Sheets(Sheets.Count)

'Build header
    Worksheets("Totals").Cells(1, 2) = "Conveyor Area"
    Worksheets("Totals").Cells(1, 3) = "Total CL100 Units"
    Worksheets("Totals").Cells(1, 4) = "Total CL200 Units"
    Worksheets("Totals").Cells(1, 5) = "CL200 .75HP"
    Worksheets("Totals").Cells(1, 6) = "CL200 1HP"
    Worksheets("Totals").Cells(1, 7) = "CL200 2HP"
    Worksheets("Totals").Cells(1, 8) = "CL200 3HP"
    Worksheets("Totals").Cells(1, 9) = "CL200 5HP"
    Worksheets("Totals").Cells(1, 10) = "CL200 7.5HP"
    Worksheets("Totals").Cells(1, 11) = "CL200 10HP"
    ActiveSheet.Cells.Select
    Selection.Columns.AutoFit
    ActiveSheet.Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    
    
'Put border around header
    ActiveSheet.Range("B1:K1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    ActiveSheet.Columns("B:K").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
ActiveSheet.Range("b2").Select
iTotalRow = 2
WriteRow = 1

iRow = 2
c = 2

    For Each oSheet In oWorkbook.Worksheets
        If oSheet.Name <> "Totals" And oSheet.Name <> "ELM_Data" And oSheet.Name <> "Formatted_Data" _
            And oSheet.Name <> "Formatted_Data" And oSheet.Name <> "Instructions for use" Then
            WriteRow = WriteRow + 1
            ActiveSheet.Cells(WriteRow, 2) = oSheet.Name
            
           
            While Worksheets(oSheet.Name).Cells(iRow, c) <> "" 'loop while the cell tested is not empty
            
            
            'cycle through all the rows of each sheet and retrieve the data
            
                If InStr(Worksheets(oSheet.Name).Cells(iRow, 5).Text, "CL100") > 0 Then
                cCL100 = cCL100 + 1
                End If
                                
                If InStr(Worksheets(oSheet.Name).Cells(iRow, 5).Text, "CL200") > 0 Then
                cCL200 = cCL200 + 1
                End If
                
                If InStr(Worksheets(oSheet.Name).Cells(iRow, 5).Text, "CL200") > 0 And _
                    Worksheets(oSheet.Name).Cells(iRow, 6).Value = 0.75 Then
                    cCL200_75 = cCL200_75 + 1
                End If
                If InStr(Worksheets(oSheet.Name).Cells(iRow, 5).Text, "CL200") > 0 And _
                    Worksheets(oSheet.Name).Cells(iRow, 6).Value = 1 Then
                    cCL2001 = cCL2001 + 1
                End If
                If InStr(Worksheets(oSheet.Name).Cells(iRow, 5).Text, "CL200") > 0 And _
                    Worksheets(oSheet.Name).Cells(iRow, 6).Value = 2 Then
                    cCL2002 = cCL2002 + 1
                End If
                If InStr(Worksheets(oSheet.Name).Cells(iRow, 5).Text, "CL200") > 0 And _
                    Worksheets(oSheet.Name).Cells(iRow, 6).Value = 3 Then
                    cCL2003 = cCL2003 + 1
                End If
                If InStr(Worksheets(oSheet.Name).Cells(iRow, 5).Text, "CL200") > 0 And _
                    Worksheets(oSheet.Name).Cells(iRow, 6).Value = 3 Then
                    cCL2003 = cCL2003 + 1
                End If
                If InStr(Worksheets(oSheet.Name).Cells(iRow, 5).Text, "CL200") > 0 And _
                    Worksheets(oSheet.Name).Cells(iRow, 6).Value = 5 Then
                    cCL2005 = cCL2005 + 1
                End If
                If InStr(Worksheets(oSheet.Name).Cells(iRow, 5).Text, "CL200") > 0 And _
                    Worksheets(oSheet.Name).Cells(iRow, 6).Value = 7.5 Then
                    cCL2007_5 = cCL2007_5 + 1
                End If
                If InStr(Worksheets(oSheet.Name).Cells(iRow, 5).Text, "CL200") > 0 And _
                    Worksheets(oSheet.Name).Cells(iRow, 6).Value = 10 Then
                    cCL20010 = cCL20010 + 1
                End If
            iRow = iRow + 1
           Wend
          
            'code to put into cells on total sheet
           
 
            Worksheets("Totals").Cells(WriteRow, 3) = cCL100
            Worksheets("Totals").Cells(WriteRow, 4) = cCL200
            Worksheets("Totals").Cells(WriteRow, 5) = cCL200_75
            Worksheets("Totals").Cells(WriteRow, 6) = cCL2001
            Worksheets("Totals").Cells(WriteRow, 7) = cCL2002
            Worksheets("Totals").Cells(WriteRow, 8) = cCL2003
            Worksheets("Totals").Cells(WriteRow, 9) = cCL2005
            Worksheets("Totals").Cells(WriteRow, 10) = cCL2007_5
            Worksheets("Totals").Cells(WriteRow, 11) = cCL20010
   
   
             cCL100Total = cCL100Total + cCL100
             cCL200Total = cCL200Total + cCL200
             cCL200_75Total = cCL200_75Total + cCL200_75
             cCL2001Total = cCL2001Total + cCL2001
             cCL2002Total = cCL2002Total + cCL2002
             cCL2003Total = cCL2003Total + cCL2003
             cCL2005Total = cCL2005Total + cCL2005
             cCL2007_5Total = cCL2007_5Total + cCL2007_5
             cCL20010Total = cCL20010Total + cCL20010
            
             cCL100 = 0
             cCL200 = 0
             cCL200_75 = 0
             cCL2001 = 0
             cCL2002 = 0
             cCL2003 = 0
             cCL2005 = 0
             cCL2007_5 = 0
             cCL20010 = 0
            
        End If
    Next oSheet
    'Print total of all columns
    
            Worksheets("Totals").Cells(WriteRow + 1, 3) = cCL100Total
            Worksheets("Totals").Cells(WriteRow + 1, 4) = cCL200Total
            Worksheets("Totals").Cells(WriteRow + 1, 5) = cCL200_75Total
            Worksheets("Totals").Cells(WriteRow + 1, 6) = cCL2001Total
            Worksheets("Totals").Cells(WriteRow + 1, 7) = cCL2002Total
            Worksheets("Totals").Cells(WriteRow + 1, 8) = cCL2003Total
            Worksheets("Totals").Cells(WriteRow + 1, 9) = cCL2005Total
            Worksheets("Totals").Cells(WriteRow + 1, 10) = cCL2007_5Total
            Worksheets("Totals").Cells(WriteRow + 1, 11) = cCL20010Total
            
            strRange = "b" & WriteRow + 1 & ":k" & WriteRow + 1
            Worksheets("Totals").Range(strRange).Font.Bold = True
            Worksheets("Totals").Range(strRange).Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            Selection.Borders(xlEdgeLeft).LineStyle = xlNone
            
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
            End With
            Selection.Borders(xlEdgeRight).LineStyle = xlNone
            Selection.Borders(xlInsideVertical).LineStyle = xlNone
            Worksheets("Totals").Range(strRange).Select
            With Selection.Font
                .Name = "Arial"
                .Size = 12
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
         End With
End Sub
 
Sort by date Sort by votes
More info please - which totals are not calculating correctly ?

what do you mean not all sheets are being totalled ? which sheets ? is there any total or just the wrong one?

This seems like a very specific macro so without the knowledge of the data layout or output numbers, it's gonna be hard for someone to debug...

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question
 
Upvote 0 Downvote
Thanks for the response, but I figured it out. I was not resetting the row count in the right place.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Question
Run PowerShell Commands from Excel VBA
Replies
14
Views
4K
dhookom
dhookom
thanhthanh12
  • Locked
  • Question
Help vba
Replies
3
Views
646
combo
combo
xwb
  • Locked
  • Helpful tip
Performing VBA operations in other languages
Replies
1
Views
485
strongm
strongm
Andrzejek
  • Locked
  • Question
Outlook VBA - Trust access
Replies
3
Views
1K
hermanlaksko
hermanlaksko
Kymenglish
  • Locked
  • Question
Automated data entry code in MS Excel VB - Edge code how to hit enter to remove popups
Replies
3
Views
536
strongm
strongm

Part and Inventory Search

Sponsor

Back
Top