• 0

Help with VBA in Excel 2000


Question

Okay, so I am having to do a little research... I need to perform some operations on a range of cells (in a column) in Excel, and need a little help getting it done.

Here's what I have to do:

Cells in the column contain comma separated whole numbers: "1,4,5,6,7" or "1,2,3,9,11,13" etc.

I need to count the occurrences of each integer in a given column (all of the cells of the range). I was able to count the occurences of a number in a range, but it counted the digits that were part of two-digit numbers as well which gives me an incorrect count.

I was thinking about looping through the rows in a column, and splitting the each cell's value into an array, then counting the elements in the arrays with a certain value, but I wasn't sure how to read the cells into arrays or count the elements and write it back to a cell.

Can anyone help me out? I've written several apps in VB.NET, but none involved reading/writing to Excel. I'm sorry if I didn't explain it well, but I would be happy to try to explain better if it might help. Thanks in advance.

Link to comment
Share on other sites

5 answers to this question

Recommended Posts

  • 0

Hey, I don't have time tonight to alter the code, but I found this online that should give you a great start to the problem...

http://stackoverflow.com/questions/471435/...d-cells-to-rows

specific code is: it's pretty well documented, and looks like it works. should only need minor modifications to make it work with your problem

Option Explicit

Sub Macro1()

Dim fromCol As String

Dim toCol As String

Dim fromRow As String

Dim toRow As String

Dim inVal As String

Dim outVal As String

Dim commaPos As Integer

' Copy from column A to column B.'

fromCol = "A"

toCol = "B"

fromRow = "1"

toRow = "1"

' Go until no more entries in column A.'

inVal = Range(fromCol + fromRow).Value

While inVal <> ""

' Go until all sub-entries used up.'

While inVal <> ""

Range(fromCol + fromRow).Select

' Extract each subentry.'

commaPos = InStr(1, inVal, ",")

While commaPos <> 0

' and write to output column.'

outVal = Left(inVal, commaPos - 1)

Range(toCol + toRow).Select

Range(toCol + toRow).Value = outVal

toRow = Mid(Str(Val(toRow) + 1), 2)

' Remove that sub-entry.'

inVal = Mid(inVal, commaPos + 1)

While Left(inVal, 1) = " "

inVal = Mid(inVal, 2)

Wend

commaPos = InStr(1, inVal, ",")

Wend

' Get last sub-entry (or full entry if no commas).'

Range(toCol + toRow).Select

Range(toCol + toRow).Value = inVal

toRow = Mid(Str(Val(toRow) + 1), 2)

inVal = ""

Wend

' Advance to next source row.'

fromRow = Mid(Str(Val(fromRow) + 1), 2)

Range(fromCol + fromRow).Select

inVal = Range(fromCol + fromRow).Value

Wend

End Sub

good luck...

Link to comment
Share on other sites

  • 0

thanks, i'll take a look at it today and see if i can't make it do what i need it to do...

oh, but if i write sub procedures/macros in an excel worksheet, do i have to call them?

Link to comment
Share on other sites

  • 0

If I wanted to capture the selected range of cells, and execute this macro, then select a destination column, or cell to start putting the output data, how would I do that?

Link to comment
Share on other sites

  • 0

Okay, I used that example, changed it to allow for selection of a range, well, a starting cell at least. However, I want to find the MIN and MAX values of the output values (column B for now). Then, I want to make a For Next loop to count the occurrences for each value and place the results somewhere else on the sheet..

For MIN(output) To MAX(output) Step 1

CountOccurrences

(place count somewhere on sheet)

Next

Option Explicit
Sub TestMacro()

Dim fromCol As Integer
Dim fromRow As Integer

Dim toCol As String
Dim toRow As String

Dim inVal As String
Dim outVal As String

Dim commaPos As Integer

Dim minVal As Integer
Dim maxVal As Integer

' Set source and destination columns
fromCol = ActiveCell.Column
toCol = "B"
fromRow = ActiveCell.Row
toRow = "1"

' Process cells in source column
inVal = Cells(fromRow, fromCol).Value
While inVal &lt;&gt; ""

' Process elements in cells
While inVal &lt;&gt; ""
Cells(fromRow, fromCol).Select

' Extract each element
commaPos = InStr(1, inVal, ",")
While commaPos &lt;&gt; 0

' Write individual elements to column
outVal = Left(inVal, commaPos - 1)
Range(toCol + toRow).Select
Range(toCol + toRow).Value = outVal
toRow = Mid(str(Val(toRow) + 1), 2)

' Remove processed element
inVal = Mid(inVal, commaPos + 1)
While Left(inVal, 1) = " "
inVal = Mid(inVal, 2)
Wend
commaPos = InStr(1, inVal, ",")
Wend

' Get last element
Range(toCol + toRow).Select
Range(toCol + toRow).Value = inVal
toRow = Mid(str(Val(toRow) + 1), 2)
inVal = ""
Wend

' Advance to next source row.'
fromRow = Mid(str(Val(fromRow) + 1), 2)
Cells(fromRow, fromCol).Select
inVal = Cells(fromRow, fromCol).Value
Wend

End Sub

Function CountOccurrences(str, substring) As Long
	Dim x As Variant
	x = Split(str, substring)
	CountOccurrences = UBound(x)
End Function

I know the CountOccurrences function won't work as it is, but I'm trying to find out how to place place the counts somewhere in the sheet.

Link to comment
Share on other sites

  • 0

Okay, what's up with the edit post feature? Did they reduce the time period?

I wrote a few statements at the end that count the occurrences of the values between the min and max of the output in Column B. Is there any way to remove my references to the range? Instead of "B1", "B24" I would like to tell it to go to the range that was output.

Option Explicit
Sub TestMacro()

Dim fromCol As Integer
Dim fromRow As Integer

Dim toCol As String
Dim toRow As String

Dim inVal As String
Dim outVal As String

Dim commaPos As Integer

Dim intCountRow As Integer
Dim intCountCol As Integer
Dim intResponseChoice As Integer
Dim intminVal As Integer
Dim intmaxVal As Integer

'Set source and destination columns
fromCol = ActiveCell.Column
toCol = "B"
fromRow = ActiveCell.Row
toRow = "1"

'Process cells in source column
inVal = Cells(fromRow, fromCol).Value
While inVal &lt;&gt; ""

'Process elements in cells
	While inVal &lt;&gt; ""

		'Extract each element
		commaPos = InStr(1, inVal, ",")
		While commaPos &lt;&gt; 0

			'Write individual elements to column
			outVal = Left(inVal, commaPos - 1)
			Range(toCol + toRow).Select
			Range(toCol + toRow).Value = outVal
			toRow = Mid(str(Val(toRow) + 1), 2)

			'Remove processed element
			inVal = Mid(inVal, commaPos + 1)
				While Left(inVal, 1) = " "
				inVal = Mid(inVal, 2)
				Wend
			commaPos = InStr(1, inVal, ",")
		Wend

	'Get last element
	Range(toCol + toRow).Select
	Range(toCol + toRow).Value = inVal
	toRow = Mid(str(Val(toRow) + 1), 2)
	inVal = ""
	Wend

'Advance to next source row
fromRow = Mid(str(Val(fromRow) + 1), 2)
Cells(fromRow, fromCol).Select
inVal = Cells(fromRow, fromCol).Value
Wend

intCountRow = ActiveCell.Row
intCountCol = ActiveCell.Column
intminVal = Application.Min(Range("B1", "B24"))
intmaxVal = Application.Max(Range("B1", "B24"))
intResponseChoice = intminVal

For intResponseChoice = intminVal To intmaxVal Step 1
Cells(intCountRow, intCountCol).Value = Application.CountIf(Range("B1", "B24"), intResponseChoice)
Cells(intCountRow, intCountCol + 1).Value = "responses for choice number " &amp; intResponseChoice
intCountRow = intCountRow + 1
Next

End Sub

Link to comment
Share on other sites

This topic is now closed to further replies.
  • Recently Browsing   0 members

    • No registered users viewing this page.