Macro to sequence ("$A:$A") to ("$IV:$IV")

[ucanalways]

Is there any macro that can be made to simplify the code below,, such
that ("$A:$A"), is automatically replaced by B,C,D.....IV, insteading
of having something given below? Please let me know. Thanks

Application.Run "ATPVBAEN.XLA!Histogram", ActiveSheet.Range("$A:$A"),
_
"", Sheets("Sheet4").Range("$A:$A"), False, False, True, True

Application.Run "ATPVBAEN.XLA!Histogram", ActiveSheet.Range("$B:$B"),
_
"", Sheets("Sheet4").Range("$B:$B"), False, False, True, True

Application.Run "ATPVBAEN.XLA!Histogram", ActiveSheet.Range("$C:$C"),
_
"", Sheets("Sheet4").Range("$C:$C"), False, False, True, True

Application.Run "ATPVBAEN.XLA!Histogram", ActiveSheet.Range("$C:$C"),
_
"", Sheets("Sheet4").Range("$D:$D"), False, False, True, True
............
................
...................

Application.Run "ATPVBAEN.XLA!Histogram", ActiveSheet.Range("$IV:
$IV"), _
"", Sheets("Sheet4").Range("$IV:$IV"), False, False, True, True

 

[Guest]

Set up a For Loop that goes across the columns:

replace
Range("$A:$A")
with
Cells(i1,i).EntireColumn

For i=1 to 255
some code
Next

 

[Bill Renaud]

Try this (untested):

Public Sub MakeHistograms()
Dim wsActive As Worksheet
Dim wsSheet4 As Worksheet
Dim lngColumn As Long

Set wsActive = ActiveSheet
Set wsSheet4 = ActiveWorkbook.Worksheets("Sheet4")

For lngColumn = 1 To 256
Application.Run "ATPVBAEN.XLA!Histogram", _
wsActive.Columns(lngColumn), _
"", _
wsSheet4.Columns(lngColumn), _
False, False, True, True
Next lngColumn
End Sub

 

[ucanalways]

Is there any macro that can be made to simplify the code below,, such
that ("$A:$A"), is automatically replaced by B,C,D.....IV, insteading
of having something given below? Please let me know. Thanks

Application.Run "ATPVBAEN.XLA!Histogram", ActiveSheet.Range("$A:$A"),
_
"", Sheets("Sheet4").Range("$A:$A"), False, False, True, True

Application.Run "ATPVBAEN.XLA!Histogram", ActiveSheet.Range("$B:$B"),
_
"", Sheets("Sheet4").Range("$B:$B"), False, False, True, True

Application.Run "ATPVBAEN.XLA!Histogram", ActiveSheet.Range("$C:$C"),
_
"", Sheets("Sheet4").Range("$C:$C"), False, False, True, True

Application.Run "ATPVBAEN.XLA!Histogram", ActiveSheet.Range("$C:$C"),
_
"", Sheets("Sheet4").Range("$D:$D"), False, False, True, True
...........
...............
..................

Application.Run "ATPVBAEN.XLA!Histogram", ActiveSheet.Range("$IV:
$IV"), _
"", Sheets("Sheet4").Range("$IV:$IV"), False, False, True, True

I got the concept now but the code gives some error. Can someone help
rectifying the error?

Thanks

Sub hist_gen()
Dim rng As Range
Dim rng1 As Range

Dim i As Integer

For i = 1 To 256


Set rng = Range("A:IV")
'rng.Columns(i).Select

Set rng1 = rng.Columns(i)


Application.Run "ATPVBAEN.XLA!Histogram", ActiveSheet.rng1, _
"", Sheets("Sheet2").rng1, False, False, True, True

Next
End Sub

 

[ucanalways]

I got the concept now but the code gives some error. Can someone help
rectifying the error?

Thanks

Sub hist_gen()
Dim rng As Range
Dim rng1 As Range

Dim i As Integer

For i = 1 To 256

Set rng = Range("A:IV")
'rng.Columns(i).Select

Set rng1 = rng.Columns(i)

Application.Run "ATPVBAEN.XLA!Histogram", ActiveSheet.rng1, _
"", Sheets("Sheet2").rng1, False, False, True, True

Next
End Sub- Hide quoted text -

- Show quoted text -

Bill, Gary Thanks for your help.

Bill, I am using your code. But histogram gives an error saying that
"Input range must contain atleast one value".

So, I would like to have a condition like "If column in the
activehseet does not have any data, then skip that column and go to
next column". Please let me know.. Gary, if you know this, then please
let me know the code for this. Thanks

 

[Bill Renaud]

Compiled, but only partially tested (I commented out the Application.Run
command and used a MsgBox):

'----------------------------------------------------------------------
Public Sub MakeHistograms()
Dim wsActive As Worksheet
Dim wsSheet4 As Worksheet
Dim lngColumn As Long
Dim rngColumn As Range
Dim rngCellsWithData As Range

Set wsActive = ActiveSheet
Set wsSheet4 = ActiveWorkbook.Worksheets("Sheet4")

On Error Resume Next

For lngColumn = 1 To 256
Set rngColumn = wsActive.Columns(lngColumn)
Set rngCellsWithData = rngColumn.SpecialCells(xlCellTypeConstants)

If Not rngCellsWithData Is Nothing _
Then
Application.Run "ATPVBAEN.XLA!Histogram", _
rngColumn, _
"", _
wsSheet4.Columns(lngColumn), _
False, False, True, True
End If
Set rngCellsWithData = Nothing 'Reset for next loop.
Next lngColumn
End Sub

 

[ucanalways]

Compiled, but only partially tested (I commented out the Application.Run
command and used a MsgBox):

'----------------------------------------------------------------------
Public Sub MakeHistograms()
Dim wsActive As Worksheet
Dim wsSheet4 As Worksheet
Dim lngColumn As Long
Dim rngColumn As Range
Dim rngCellsWithData As Range

Set wsActive = ActiveSheet
Set wsSheet4 = ActiveWorkbook.Worksheets("Sheet4")

On Error Resume Next

For lngColumn = 1 To 256
Set rngColumn = wsActive.Columns(lngColumn)
Set rngCellsWithData = rngColumn.SpecialCells(xlCellTypeConstants)

If Not rngCellsWithData Is Nothing _
Then
Application.Run "ATPVBAEN.XLA!Histogram", _
rngColumn, _
"", _
wsSheet4.Columns(lngColumn), _
False, False, True, True
End If
Set rngCellsWithData = Nothing 'Reset for next loop.
Next lngColumn
End Sub

Bill, Justto test I have three columns with data and the code works
well for rows with data. When I becomes 4, I get an error. "No cells
were found" for this line

Set rngCellsWithData = rngColumn.SpecialCells(xlCellTypeConstants)

I tested with msgbox too and still the error appears.. Any idea why
this is happening. Thanks

 

[ucanalways]

Bill, Justto test I have three columns with data and the code works
well for rows with data. When I becomes 4, I get an error. "No cells
were found" for this line

Set rngCellsWithData = rngColumn.SpecialCells(xlCellTypeConstants)

I tested with msgbox too and still the error appears.. Any idea why
this is happening. Thanks- Hide quoted text -

- Show quoted text -

Bill, I got it right now. Initially I commented the line On Error
Resume Next. Now, I understand you had had it on purpose. Thanks

 

[Bill Renaud]

Yes, it would probably be better to use something like:

For lngColumn = 1 To wsActive.UsedRange.Columns.Count

This will avoid looping through empty columns after the last one and will
make the macro run a little faster. This assumes that column $A is not
empty.

 

[ucanalways]

Yes, it would probably be better to use something like:

For lngColumn = 1 To wsActive.UsedRange.Columns.Count

This will avoid looping through empty columns after the last one and will
make the macro run a little faster. This assumes that column $A is not
empty.

Bill, I tried using this. I get the same error again i.e. No cells
were found. In this case, I have value in Column A, B and D.

So, I am using your previous code that has On Error Resume Next. It
works great.

 

[ucanalways]

Compiled, but only partially tested (I commented out the Application.Run
command and used a MsgBox):

'----------------------------------------------------------------------
Public Sub MakeHistograms()
Dim wsActive As Worksheet
Dim wsSheet4 As Worksheet
Dim lngColumn As Long
Dim rngColumn As Range
Dim rngCellsWithData As Range

Set wsActive = ActiveSheet
Set wsSheet4 = ActiveWorkbook.Worksheets("Sheet4")

On Error Resume Next

For lngColumn = 1 To 256
Set rngColumn = wsActive.Columns(lngColumn)
Set rngCellsWithData = rngColumn.SpecialCells(xlCellTypeConstants)

If Not rngCellsWithData Is Nothing _
Then
Application.Run "ATPVBAEN.XLA!Histogram", _
rngColumn, _
"", _
wsSheet4.Columns(lngColumn), _
False, False, True, True
End If
Set rngCellsWithData = Nothing 'Reset for next loop.
Next lngColumn
End Sub

Bill, Justto test I have three columns with data and the code works
well for rows with data. When I becomes 4, I get an error. "No cells
were found" for this line

Set rngCellsWithData = rngColumn.SpecialCells(xlCellTypeConstants)

Any idea why this is happening. I tested with msgbox too and still the
error appears

 

[Bill Renaud]

I am still running Excel 2000, so can't exactly verify what you are seeing.
I think the Analysis ToolPak works slightly differently in different
versions of Excel. Whenever I turn on the macro recorder and attempt to
create a Histogram, I get the following code:

Application.Run "ATPVBAEN.XLA!Histogram", , "", , _
False, False, True, True

The macro recorder returns nothing for the 1st and 3rd arguments of the
Histogram function. According to the Object Browser, the call and arguments
for the Excel 2000 version of the Analysis ToolPak Histogram function
is/are as follows:

Sub Histogram(inprng, [outrng], [binrng], [pareto], [chartc], [chart],
[labels])

Therefore, I am assuming from your recorded macro that you are attempting
to specify the input range and the bin range, but not the output range. You
are also specifying that your input data has labels at the top of the data
and you are requesting a chart to be made.

1. Is each column of data on the active sheet a different number of rows
(maybe we should assume they are, even if they are not).
2. Does each column of data on the active sheet (the "Data") actually need
a separate set of Bin values ("Sheet4")?
3. What is on "Sheet4" in your workbook? Is this where you have your Bin
values specified? Do they have a label on row 1 (i.e. "Bin" or something)?
4. I notice that the macro runs a long time when you allow the input range
and Bin range to be an entire column. We should probably shorten this down
to be the cells that actually have data.

Let me know more specifically what the data looks like on both worksheets.
I'll then attempt to fix the macro.

You might also refer to the Microsoft KB article "How to create an Excel
histogram by using Automation and Analysis ToolPak" at
http://support.microsoft.com/default.aspx?SCID=kb;en-us;270844 for some
additional ideas and tips.

 

[ucanalways]

I am still running Excel 2000, so can't exactly verify what you are seeing.
I think the Analysis ToolPak works slightly differently in different
versions of Excel. Whenever I turn on the macro recorder and attempt to
create a Histogram, I get the following code:

Application.Run "ATPVBAEN.XLA!Histogram", , "", , _
False, False, True, True

The macro recorder returns nothing for the 1st and 3rd arguments of the
Histogram function. According to the Object Browser, the call and arguments
for the Excel 2000 version of the Analysis ToolPak Histogram function
is/are as follows:

Sub Histogram(inprng, [outrng], [binrng], [pareto], [chartc], [chart],
[labels])

Therefore, I am assuming from your recorded macro that you are attempting
to specify the input range and the bin range, but not the output range. You
are also specifying that your input data has labels at the top of the data
and you are requesting a chart to be made.

Bill, your assumption is perfect

1. Is each column of data on the active sheet a different number of rows
(maybe we should assume they are, even if they are not).
Yes.

2. Does each column of data on the active sheet (the "Data") actually need
a separate set of Bin values ("Sheet4")?
Yes.

3. What is on "Sheet4" in your workbook? Is this where you have your Bin
values specified? Do they have a label on row 1 (i.e. "Bin" or something)?

Sheet4 has Bins. They have labels in A1, B1, C1 etc....I have setup
the sheet such that the bins are automatically calculated. I have a
sheet three that finds the max and min of a column of the activesheet.
I dividing the min and max into 20 equal intervals and set them up as
bins in Sheet4.

4. I notice that the macro runs a long time when you allow the input range
and Bin range to be an entire column. We should probably shorten this down
to be the cells that actually have data.

You are right but I making this template to handle 65536 data. So,
execution time should not be a concern here.

Let me know more specifically what the data looks like on both worksheets.
I'll then attempt to fix the macro.

You might also refer to the Microsoft KB article "How to create an Excel
histogram by using Automation and Analysis ToolPak" athttp://support.microsoft.com/default.aspx?SCID=kb;en-us;270844for some
additional ideas and tips.

Sure.. I will take a look at it. Thanks.. The code with On Error
Resume Next works great.

 

[Bill Renaud]

I revised the routine as follows. I added a function to determine the
actual data area in each column (both Data and Bin values). The logic
inside the For loop now only creates a Histogram if the number of cells on
the data worksheet is greater than 1 (column must have data besides the
column label). I used "Bins" for the name of the worksheet that has the Bin
values (you can change it back to "Sheet4", if you like).

I also name each Histogram worksheet as "Hist Column #", where "#" is the
column number where the data originated from.

'----------------------------------------------------------------------
Public Sub MakeHistograms()
Dim wsData As Worksheet 'Worksheet that contains the data.
Dim wsBins As Worksheet 'Worksheet with bin values.
Dim lngColumnsOfData As Long 'Number of columns of non-blank data.
Dim ilngColumn As Long 'Index of columns on Data and Bin sheets.
Dim rngData As Range
Dim rngBin As Range

Application.ScreenUpdating = False

Set wsData = ActiveSheet
Set wsBins = ActiveWorkbook.Worksheets("Bins")

lngColumnsOfData = wsData.UsedRange.Columns.Count

For ilngColumn = 1 To lngColumnsOfData
Set rngData = DataColumn(wsData.Cells(1, ilngColumn))

'Create Histogram only if column actually contains data.
'Assume row 1 is the header (column label).
If rngData.Cells.Count > 1 _
Then
Set rngBin = DataColumn(wsBins.Cells(1, ilngColumn))

Application.Run "ATPVBAEN.XLA!Histogram", _
rngData, _
"", _
rngBin, _
False, False, True, True

'Newly-created Histogram worksheet is now active.
With ActiveSheet
.Name = "Hist Column " & ilngColumn
.Range("$A$1").Select
End With
End If
Next ilngColumn
End Sub

'----------------------------------------------------------------------
'DataColumn returns a range that is the extension of CellRow1
'down to the last non-blank cell in the same column.

Private Function DataColumn(CellRow1 As Range) As Range
Dim ws As Worksheet
Dim rngColumn As Range
Dim rngLastCell As Range

Set ws = CellRow1.Parent
Set rngColumn = CellRow1.EntireColumn
Set rngLastCell = rngColumn.Find _
(What:="*", _
After:=CellRow1, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If rngLastCell Is Nothing _
Then
'Column is totally blank; it contains no data!
Set DataColumn = CellRow1
Else
Set DataColumn = ws.Range(CellRow1, rngLastCell)
End If
End Function

 

[Thulasiram]

I revised the routine as follows. I added a function to determine the
actual data area in each column (both Data and Bin values). The logic
inside the For loop now only creates a Histogram if the number of cells on
the data worksheet is greater than 1 (column must have data besides the
column label). I used "Bins" for the name of the worksheet that has the Bin
values (you can change it back to "Sheet4", if you like).

I also name each Histogram worksheet as "Hist Column #", where "#" is the
column number where the data originated from.

'----------------------------------------------------------------------
Public Sub MakeHistograms()
Dim wsData As Worksheet 'Worksheet that contains the data.
Dim wsBins As Worksheet 'Worksheet with bin values.
Dim lngColumnsOfData As Long 'Number of columns of non-blank data.
Dim ilngColumn As Long 'Index of columns on Data and Bin sheets.
Dim rngData As Range
Dim rngBin As Range

Application.ScreenUpdating = False

Set wsData = ActiveSheet
Set wsBins = ActiveWorkbook.Worksheets("Bins")

lngColumnsOfData = wsData.UsedRange.Columns.Count

For ilngColumn = 1 To lngColumnsOfData
Set rngData = DataColumn(wsData.Cells(1, ilngColumn))

'Create Histogram only if column actually contains data.
'Assume row 1 is the header (column label).
If rngData.Cells.Count > 1 _
Then
Set rngBin = DataColumn(wsBins.Cells(1, ilngColumn))

Application.Run "ATPVBAEN.XLA!Histogram", _
rngData, _
"", _
rngBin, _
False, False, True, True

'Newly-created Histogram worksheet is now active.
With ActiveSheet
.Name = "Hist Column " & ilngColumn
.Range("$A$1").Select
End With
End If
Next ilngColumn
End Sub

'----------------------------------------------------------------------
'DataColumn returns a range that is the extension of CellRow1
'down to the last non-blank cell in the same column.

Private Function DataColumn(CellRow1 As Range) As Range
Dim ws As Worksheet
Dim rngColumn As Range
Dim rngLastCell As Range

Set ws = CellRow1.Parent
Set rngColumn = CellRow1.EntireColumn
Set rngLastCell = rngColumn.Find _
(What:="*", _
After:=CellRow1, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If rngLastCell Is Nothing _
Then
'Column is totally blank; it contains no data!
Set DataColumn = CellRow1
Else
Set DataColumn = ws.Range(CellRow1, rngLastCell)
End If
End Function

Bill, thanks a lot for this code too. I will give this a shot

 

[ucanalways]

I revised the routine as follows. I added a function to determine the
actual data area in each column (both Data and Bin values). The logic
inside the For loop now only creates a Histogram if the number of cells on
the data worksheet is greater than 1 (column must have data besides the
column label). I used "Bins" for the name of the worksheet that has the Bin
values (you can change it back to "Sheet4", if you like).

I also name each Histogram worksheet as "Hist Column #", where "#" is the
column number where the data originated from.

'----------------------------------------------------------------------
Public Sub MakeHistograms()
Dim wsData As Worksheet 'Worksheet that contains the data.
Dim wsBins As Worksheet 'Worksheet with bin values.
Dim lngColumnsOfData As Long 'Number of columns of non-blank data.
Dim ilngColumn As Long 'Index of columns on Data and Bin sheets.
Dim rngData As Range
Dim rngBin As Range

Application.ScreenUpdating = False

Set wsData = ActiveSheet
Set wsBins = ActiveWorkbook.Worksheets("Bins")

lngColumnsOfData = wsData.UsedRange.Columns.Count

For ilngColumn = 1 To lngColumnsOfData
Set rngData = DataColumn(wsData.Cells(1, ilngColumn))

'Create Histogram only if column actually contains data.
'Assume row 1 is the header (column label).
If rngData.Cells.Count > 1 _
Then
Set rngBin = DataColumn(wsBins.Cells(1, ilngColumn))

Application.Run "ATPVBAEN.XLA!Histogram", _
rngData, _
"", _
rngBin, _
False, False, True, True

'Newly-created Histogram worksheet is now active.
With ActiveSheet
.Name = "Hist Column " & ilngColumn
.Range("$A$1").Select
End With
End If
Next ilngColumn
End Sub

'----------------------------------------------------------------------
'DataColumn returns a range that is the extension of CellRow1
'down to the last non-blank cell in the same column.

Private Function DataColumn(CellRow1 As Range) As Range
Dim ws As Worksheet
Dim rngColumn As Range
Dim rngLastCell As Range

Set ws = CellRow1.Parent
Set rngColumn = CellRow1.EntireColumn
Set rngLastCell = rngColumn.Find _
(What:="*", _
After:=CellRow1, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If rngLastCell Is Nothing _
Then
'Column is totally blank; it contains no data!
Set DataColumn = CellRow1
Else
Set DataColumn = ws.Range(CellRow1, rngLastCell)
End If
End Function

Bill, thanks a lot for this code too. I will give this a shot