arrays again

[RobcPettit]

Could somebody look at the following and advice if there is a better way to do:
Dim Emptydat()

Range("a65536").End(xlUp).Select
ActiveCell.Offset(1, 1).Select
n = Range("names").Count
Epicdat = Range("names")
Range(ActiveCell, ActiveCell.Offset(0, n)).Select
Blankdat = Selection
For B = 1 To n
If Blankdat(1, B) = "" Then
d = d + 1
ReDim Preserve Emptydat(1 To d)
Emptydat(d) = Epicdat(1, B)
End If
Next B

A B C D F
1 Title1 Title2 Title3 Title4
2 Date1 1 3 5 6
3 Date2 1 3 5 6
4 Date3 1 3 5 6
5 Date4 1 5 6


Bassically at the top of mysheet I have row 1 named 'names', about 200 col
wide, but this changes occasionally. In col 'A' I have dates going back 6 yrs
whence Im using ' Range("a65536").End(xlUp).Select' because this changes every
day. I then enter values beside each date, under each title in the 'names'
range. what I want to do with this program is from the last date in col a, is
check along the Row to see if there are any missing values, if so enter the
title of that col into an array, which Iater place in a worksheet. So in above
eg, C5 is blank, so I would enter Title2 into array.This program works perfect,
as Im using arrays I thought there may be a better way to use them.

 

[Rob van Gelder]

Logic is good.


I generally Tab on Sub, If, With, For, Do statments (I think that's all of
them). Anything else remains on the same tabbing level.

There are some shortcuts though:

You should dimension all variables. - Always have Option Explicit at the top
of the code. Tools | Options | Require Variable Declaration
You could join lines into one: Range("a65536").End(xlUp).Offset(1,1).Select

Even better is not to Select at all.
eg.
Dim rng as Range
....
Set rng = Cells(Rows.Count, 1).End(xlUp).Offset(1,1)
....

There's a SpecialCells method which can return Blank Cells.

Below is my approach.

Sub test()
Dim lngLastCol As Long, rngBlanks As Range, rng As Range
Dim arr() As String, i As Long

With Sheet1
lngLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
Set rngBlanks = Range(.Cells(2, 2), .Cells(Rows.Count,
1).End(xlUp).Offset(0, lngLastCol - 1)).SpecialCells(xlCellTypeBlanks)
On Error Resume Next
For Each rng In rngBlanks.EntireColumn
i = UBound(arr) + 1
If Err.Number Then
ReDim arr(0): i = 0
Err.Clear
Else
ReDim Preserve arr(i)
End If
arr(i) = rng.Cells(1, 1).Value
Next
On Error GoTo 0
End With
End Sub

Rob

 

[Alan Beban]

I don't know about better, but here's a different way:

Sub testit2()
Dim Emptydat() As String
Dim iCols As Integer, iRows As Long
Dim rng1 As Range, rng2 As Range
Dim i As Integer, k As Integer, numBlanks As Integer
iCols = Range("iv2").End(xlToLeft).Column
iRows = Range("A65536").End(xlUp).Row
Set rng1 = Range(Cells(1, 1), Cells(1, iCols))
Set rng2 = Range(Cells(iRows, 1), Cells(iRows, iCols))
numBlanks = Application.CountIf(rng2, "")
ReDim Emptydat(1 To numBlanks)
k = 1
For i = 1 To iCols
If rng2(i) = "" Then
Emptydat(k) = rng1(i).Value
Debug.Print Emptydat(k)
k = k + 1
End If
Next
End Sub

Alan Beban

 

[Robert Pettit]

Thankyou both for your replys. Both these answers give me something to
work through. This newsgroup is proving invaluable, hopefully I will be
in a position to contribute with answers in the future. Thankyou again
to both.
Robert