Input Box flaw?

[GS]

Oops! I messed up not including the header row in Redim or For...Next
escape. Revise as follows, otherwise the last row of data will be
missing...

Sub CopyYearData_v3()
Dim vData, vDataOut(), vAns, n&, j&, k#, lCols&, lNextRow&
Const lSearchCol& = 8 '//edit to suit

vAns = Application.InputBox("Enter the year", Type:=1)
If vAns = False Then Beep: Exit Sub '//user cancels
k = WorksheetFunction.CountIf(Columns(lSearchCol), vAns)
If k = 0 Then Beep: Exit Sub '//year not found

lCols = ActiveSheet.UsedRange.Columns.Count
If Not lCols >= lSearchCol Then Beep: Exit Sub

vData = ActiveSheet.UsedRange

ReDim vDataOut(1 To k + 1, 1 To lCols)

For n = LBound(vData) To UBound(vData)
If vData(n, lSearchCol) = vAns Then
lNextRow = lNextRow + 1
For j = 1 To lCols
If lNextRow = 1 Then vDataOut(lNextRow, j) = vData(1, j) _
Else vDataOut(lNextRow, j) = vData(n, j)
Next 'j
End If 'vData(n, 8) = vAns

If lNextRow = k + 1 Then Exit For

Next 'n
Workbooks.Add
Cells(1).Resize(UBound(vDataOut), UBound(vDataOut, 2)) = vDataOut
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[JonathanK1]

;1610966']Oops! I messed up not including the header row in Redim o
For...Next
escape. Revise as follows, otherwise the last row of data will be
missing...

-

Sub CopyYearData_v3()
Dim vData, vDataOut(), vAns, n&, j&, k#, lCols&, lNextRow&
Const lSearchCol& = 8 '//edit to suit

vAns = Application.InputBox("Enter the year", Type:=1)
If vAns = False Then Beep: Exit Sub '//user cancels
k = WorksheetFunction.CountIf(Columns(lSearchCol), vAns)
If k = 0 Then Beep: Exit Sub '//year not found

lCols = ActiveSheet.UsedRange.Columns.Count
If Not lCols >= lSearchCol Then Beep: Exit Sub

vData = ActiveSheet.UsedRange-

ReDim vDataOut(1 To k + 1, 1 To lCols)-

For n = LBound(vData) To UBound(vData)
If vData(n, lSearchCol) = vAns Then
lNextRow = lNextRow + 1
For j = 1 To lCols
If lNextRow = 1 Then vDataOut(lNextRow, j) = vData(1, j) _
Else vDataOut(lNextRow, j) = vData(n, j)
Next 'j
End If 'vData(n, 8) = vAns-

If lNextRow = k + 1 Then Exit For-

Next 'n
Workbooks.Add
Cells(1).Resize(UBound(vDataOut), UBound(vDataOut, 2)) = vDataOut
End Sub-

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Thank you both so much, this works great. My only question is - i
seems the answer (in the input box) must be a date. Would this cod
work with another set of data in the H/8 column? I have one sheet wher
there are parts in this column (A713 for example), but when I try th
code for that it says "Number is not valid."

Thanks again!

J

 

[Claus Busch]

Hi Jonathan,

Am Mon, 8 Apr 2013 10:56:37 +0000 schrieb JonathanK1:

Thank you both so much, this works great. My only question is - it
seems the answer (in the input box) must be a date. Would this code
work with another set of data in the H/8 column? I have one sheet where
there are parts in this column (A713 for example), but when I try the
code for that it says "Number is not valid."

if you want to enter a cell reference, you must change the type of the
input box to 8


Regards
Claus Busch

 

[GS]

Thank you both so much, this works great. My only question is - it

seems the answer (in the input box) must be a date.

Actually, it must be a number NOT specifically a date!

Would this code
work with another set of data in the H/8 column? I have one sheet
where
there are parts in this column (A713 for example), but when I try the
code for that it says "Number is not valid."

Set the carat inside the word InputBox and press F1 to see an
explanation for the 'Type' arg of that function. When the dialog opens,
type "inputbox" (without quotes) in the search box. Change it to suit
the type of data you want. (In this case it should be text; Type:=2)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion