PDA

View Full Version : Solved: Counting 1's in a column



cavemonkey
05-25-2007, 09:19 AM
Hi I'm a newbie in vba. I'm currently writing a code for my company that I'm attached to.

Basically I'm supposed to count the number of '1' that appeared in the spreadsheet and record them into another sheet. But there's a condition for that count, which is whenever there's a '0' in the column the counter will reset itself and count again. I'm supposed to count the number of '1' fulfilling the above condition for each column. The attached spreadsheet should be able to explain better what I'm saying. The attached one is just a sample that I made up. The actual ones contain more than what is shown.

Here is the problem, I could not get the code to copy the number of '1' for each column into the other sheet. I came up with a short code to copy the number of '1' but when fitted into the main code it doesn't seem to work.

Sub test()
Sheets("Sheet1").Select
columncount = 2
rowcount = 2
rowcount2 = 2
Count = 0
Do Until Cells(2, columncount) = ""
columncount = columncount + 1
Loop
last_column = columncount - 1
For next_column = 2 To last_column
Do Until Cells(rowcount, next_column) = ""
If Cells(rowcount, next_column) = "1" Then
Count = Count + 1
ElseIf Cells(rowcount, next_column) = "0" Then
Count = 0
End If
rowcount = rowcount + 1



Loop

rowcount = 2



Next next_column
MsgBox Count
End Sub


pls advsie thank you.

Simon Lloyd
05-25-2007, 09:59 AM
If all you want is to put the count number somewhere then:

Sub test()
Sheets("Sheet1").Select
columncount = 2
RowCount = 2
rowcount2 = 2
Count = 0
Do Until Cells(2, columncount) = ""
columncount = columncount + 1
Loop
last_column = columncount - 1
For next_column = 2 To last_column
Do Until Cells(RowCount, next_column) = ""
If Cells(RowCount, next_column) = "1" Then
Count = Count + 1
ElseIf Cells(RowCount, next_column) = "0" Then
Count = 0
End If
RowCount = RowCount + 1
Loop
RowCount = 2
Next next_column
MsgBox Count
Range("H1").Value = Count'''''i put the value in the activesheet at H1
End Sub

mdmackillop
05-25-2007, 10:24 AM
I really don't understand what you're trying to do. Can you repost your sample showing the output you expect, with some explanatory notes?

malik641
05-25-2007, 10:35 AM
Why not start from the bottom up to the first 0?

But if 0 is the last item in the column...it will continue upward until it reads a 1 and start counting up to the next zero. This can be changed if desired.
Public Sub Count1s()
Dim lCol As Long, lRow As Long
Dim lCounter As Long, i As Long

lCol = 2
lRow = Sheet1.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row

For i = lRow To 2 Step -1
If Sheet1.Cells(i, lCol).Value = 1 Then
lCounter = lCounter + 1
ElseIf Sheet1.Cells(i, lCol).Value = 0 And lCounter <> 0 Then
Exit For
End If
Next

Sheet2.Range("B2").Value = lCounter
End Sub

lucas
05-25-2007, 10:41 AM
Title of thread changed to reflect topic for searches. Help needed is not a very good title for the thread.

Bob Phillips
05-25-2007, 10:50 AM
So if you have 0011110111110111000110 Is that 4,5,3,2, or 0?

Simon Lloyd
05-25-2007, 12:56 PM
LOL! Bob i think thats a zero, it seems a pointless excercise really!, better finding the last zero and counting from there, rather than count then make the count nul then count etc!

cavemonkey
05-25-2007, 08:09 PM
I guess there's no choice but to explain everything again. Here goes hope you guys understand what I'm trying to say.

I given this task to tabulate all the different alarm trips that happened since the day 1 when the excel spreadsheet is created till now. Just that that person just need to update the spreadsheet to get the latest no. of alarm trips. Each column represents one alarm. So in the actual spreadsheet that I'm supposed to do on, there are about 4 worksheets of alarms.

So, the '1's you see in excel represents alarm being switched on and '0' means off. I need to tabulate out each and single one of the alarm's last switch on duration

What I'm hoping for is that once it has finished scanning through one column, before it does the loop and continue onto the next column, the program can record the duration the alarm is last switched on onto another worksheet.

It is possible to start looking from the bottom up but like you say what if the last cell is a '0'? Then won't the counter stop counting the '1's after that '0' to the previous possible '0'?

I was thinking changing my thread title but I just couldn't think of how am I supposed to name my title without letting other ppl misunderstand my actual problem.

Hope my explaination cleared up some doubts in any area. Thanks

cavemonkey
05-25-2007, 08:12 PM
Hope this helps.

rbrhodes
05-25-2007, 10:31 PM
Hi CM,

Try this example, I commented it but any ? post back!

Cheers,

dr

johnske
05-25-2007, 11:26 PM
Option Explicit

Sub TryThis()

Dim M As Long, N As Long, P As Long

With Worksheets("Sheet1")
For N = 2 To 5 'columns B, C, D, E
M = 0
For P = .UsedRange.Rows.Count To 2 Step -1
If .Cells(P, N).Text = "1" Then
M = M + 1
Else
If M > 0 Then Exit For 'go to next column
End If
Next
Worksheets("Sheet2").Range("B" & N) = M
Next
End With

End Sub

mdmackillop
05-26-2007, 12:45 AM
Thanks CaveMonkey,
Your latter explanation and sample was very clear, and I see you have two solutions already!
Regards
MD

malik641
05-26-2007, 09:11 AM
I was hoping to find a formula answer with no vba...oh well...

Public Function GetAddress(ByVal Rng As Excel.Range) As Excel.Range
Dim i As Long, lCount As Long
Dim rngNew As Excel.Range
For i = Rng.Rows.Count To 1 Step -1
If Rng.Cells(i, 1).Value = 0 And lCount <> 0 Then
Exit For
ElseIf Rng.Cells(i, 1).Value = 1 Then
lCount = lCount + 1
End If
Next
Set rngNew = Range(Rng.Cells(i, 1), Rng.Cells(Rng.Rows.Count, 1))
Set GetAddress = rngNew
End Function

Use it like:
=COUNTIF(getaddress(C1:C13),"=1")

Bob Phillips
05-26-2007, 09:52 AM
I was hoping to find a formula answer with no vba...oh well...
Well I am surprised, all it takes is a simple array formula



=MAX(IF((COLUMN(Sheet1!$A$1:$E$13)=MATCH($A$1&A2,Sheet1!$1:$1,0))*(Sheet1!$A$1:$E$13=1),ROW(Sheet1!$A$1:$E$13)))-
MAX(IF((COLUMN(Sheet1!$A$1:$E$13)=MATCH($A$1&A2,Sheet1!$1:$1,0))*(Sheet1!$A$1:$E$13=0)*(ROW(Sheet1!$A$1:$E$13)<
MAX(IF((COLUMN(Sheet1!$A$1:$E$13)=MATCH($A$1&A2,Sheet1!$1:$1,0))*(Sheet1!$A$1:$E$13=1),ROW(Sheet1!$A$1:$E$13)))),ROW(She et1!$A$1:$E$13)))

malik641
05-26-2007, 10:27 AM
:whistle:I'm not as well-versed in formulas as I am in VBA :blush

And in the workbook I'm using I'm placing the formula in Sheet2!$B$2, "expanding" the formula down to Sheet2!$B$5, then focusing in the formula bar and pressing Ctrl+Shift+Enter and they all return 2. They reference the correct cells in Sheet2 (from the Match($A$1&A2))...It is not working for me....I probably did something wrong, though.

Bob Phillips
05-26-2007, 10:33 AM
I was joking, it is overly-complex in a formula.

Did you use the OP's original workbook?

I forgot to mention that I had to correct the headings on sheet 1 as Alarm no. 3 and 4 had an extra space between the . and the number.

Bob Phillips
05-26-2007, 10:36 AM
Also, just noticed something else that you said.

It is not a block-array formula. So don't expand down and focus on the formula bar and array-enter it, rather select B2, enter it in the formula bar, array enter, and then copy down.

malik641
05-26-2007, 11:09 AM
Got it :) Thanks Bob

And I was about to laugh, because I did think it was a joke...but at the same time I thought, "Hmm...what if it IS an easy formula...and I'll just look like a fool by calling it a difficult one...Nah, it's too risky. I'll just tell the truth..." :)

mdmackillop
05-26-2007, 12:46 PM
Simple or not.
:clap::clap::clap:

malik641
05-26-2007, 07:29 PM
Simple or not.
:clap::clap::clap: Agreed :yes

cavemonkey
05-26-2007, 11:02 PM
Thank guys. And kudos to rbrhodes. I used your code and it is exactly what I am looking for. Thanks a lot once again.

I will try it on the actual sheet on Monday. Hopefully it looks for that. But most probably the code needs to get modified further. Thanks again. Will comment again.

Thank you to all of you guys out there.

cavemonkey
05-28-2007, 05:14 PM
Hi back again with more questions.

There are few additions i need to make for my spreadsheet
Basically its Alarm No. and and column which tells the user if the alarm is currently activated or not. I have written a code for both function but one of them is not working and I do not know where is the problem. The code actually works once or twice but when I lump all the code together into a button it stopped working.

Details would be in the sample that would be posted in the next reply.

thanks

cavemonkey
05-28-2007, 05:16 PM
Here it is.

Credit for the cAlarm code to rbrhodes. I have not put it down in the code. Will do so later. Thanks.

rbrhodes
05-28-2007, 07:17 PM
Hi cm,

Looked at what you've got and played with it a bit. Study it well grasshopper <g>.

One of the properties of the Control Toolbox buttons is "Take Focus On Click". Set it to false for the most part.

Cheers,

dr

cavemonkey
05-28-2007, 10:02 PM
Thanks rbrhodes for your help. Will look into it.

cavemonkey
05-28-2007, 11:19 PM
I look at the code. Somehow the problem still persist - Activated during the last 24 hours section. I changed the alarm sheet a little to see if the code works. But somehow it just stayed the same. I compared your code and mine. I can't seem to find the problem why the status of that section is not updated.

Sub activation()
Dim r As Long
Dim c As Long
Dim lCol As Long
Dim wsA As Worksheet
Dim wsS As Worksheet
Set wsA = Sheets("Alarms")
Set wsS = Sheets("Summary")
'speed
Application.ScreenUpdating = False
With wsA
'get last row
r = .Range("A65536").End(xlUp).Row
'get last Column
lCol = .Cells(r, 256).End(xlToLeft).Column
'col 2 to last one
For c = 2 To lCol
If Cells(r, c) = 1 Then
wsS.Cells(c, 3) = "Y"
ElseIf Cells(r, c) = 0 Then
wsS.Cells(c, 3) = "N"
End If
Next c
End With
'destroy created objects
Set wsA = Nothing
Set wsS = Nothing

'reset
Application.ScreenUpdating = True
End Sub


Thanks

rbrhodes
05-29-2007, 07:54 AM
Hi cm,

If it's supposed to check all of the rows this will do it:


Option Explicit
Sub activation()
Dim r As Long
Dim c As Long
Dim lCol As Long
Dim lRow As Long
Dim wsA As Worksheet
Dim wsS As Worksheet
Set wsA = Sheets("Alarms")
Set wsS = Sheets("Summary")
'speed
Application.ScreenUpdating = False
With wsA
'get last row
lRow = .Range("A65536").End(xlUp).Row
'get last Column
lCol = .Cells(lRow, 256).End(xlToLeft).Column
'col 2 to last one
For c = 2 To lCol
'ADDED LOOP
'last row to first row
For r = lRow To 2 Step -1
If .Cells(r, c) = "1" Then
wsS.Cells(c, 3) = "Y"
'ADDED
Exit For
ElseIf Cells(r, c) = "0" Then
wsS.Cells(c, 3) = "N"
End If
Next r
'ADDED
'if we got to here then no "1" was found in column, put "N"
If r = 1 Then wsS.Cells(c, 3) = "N"
Next c
End With
'destroy created objects
Set wsA = Nothing
Set wsS = Nothing

'reset
Application.ScreenUpdating = True
End Sub



However this can be done more efficiently as well. Since the cAlarm code is already checking if the Alarm was fired it could be one line in there instead of a separate sub. In truth it could pretty much all be one smaller sub unless you need separate control for each part. I'm sure CopyHeaders and findunit do the same thing, for example.

Cheers,

dr

rbrhodes
05-29-2007, 08:09 AM
CM,

For instance:


Option Explicit
Sub aCode()
Dim c As Long 'Column
Dim r As Long 'Row
Dim lCol As Long 'last Column Alarms
Dim aCount As Long 'Count "1's"
Dim lastRow As Long 'Last row of data Alarms
Dim cAlarm As Long 'number of Alarms counted
Dim wsA As Worksheet 'Sheet named Alarms
Dim wsS As Worksheet 'Sheet named Summary
Set wsA = Sheets("Alarms")
Set wsS = Sheets("Summary")
'speed
Application.ScreenUpdating = False

'optional
wsS.Activate
'KilltheOld (short version)
'delete all old data
wsS.Range("A2:IV65536").ClearContents
'END

'CopyHeaders

'one call to object
With wsA
'get last Alarm #
lCol = .Range("IV1").End(xlToLeft).Column
'copy Alarm #'s
.Range(Cells(1, 2).Address, Cells(1, lCol).Address).Copy
'paste special(transpose)
wsS.Range("A2").PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

'Kill "marching ants"
Application.CutCopyMode = False
'END

'Activation & cAlarm (combined)
'get last row Alarm sheet Col A as start row
lastRow = .Range("A65536").End(xlUp).Row
'when apply to the actual sheet
'lastrow = lastrow - 3

'get last Column sheet "Alarms"
lCol = .Range("IV1").End(xlToLeft).Column

'loop on all columns
For c = 2 To lCol
'loop on all rows (last to first)
For r = lastRow To 2 Step -1
'found a "1"
If .Cells(r, c) = 1 Then
aCount = aCount + 1
'found a "0"
ElseIf .Cells(r, c) = 0 Then
'found a "1", previous to this "0"
If aCount > 0 Then
'then was change. put aCount
wsS.Cells(c, 2) = aCount
wsS.Cells(c, 3) = "Y"
'and do next column
Exit For
End If
'no change = continue with this column
' last row to row 2
End If
Next r
'didn't find a "1"
If r = 1 Then wsS.Cells(c, 3) = "N"
'reset for next column
aCount = 0
Next c
End With
'END
'go home
Range("A1").Select

Set wsA = Nothing
Set wsS = Nothing

'reset
Application.ScreenUpdating = True

End Sub


Cheers,

dr

cavemonkey
05-29-2007, 08:41 AM
Gosh...ok really appreciate your help. I didn't foresee that you combined all the sub into one sub. It feels like you are doing all the work and not me.

Anyway, where do you learn all these from? Seeing you writing up these codes make me feel rather small and useless. But I learned a lot from you though.

lucas
05-29-2007, 10:04 AM
rbrhodes code is well commented too which helps others understand what's going on when it runs....

rbrhodes
05-29-2007, 11:58 PM
Hello all,

I thank you!

cavemonkey,

I learned first from a book but mostly from forums like this! Asking at first, answering (tentatively) and learning all the time...

lucas,

Thanks!

I still feel like I could explain it better! Comments are goodness though, I feel.

Anyways, glad to help. The important part to me is learning, always learning....


"Theatre is Life, film is Art, television is Furniture"

Cheers

Dusty R.