Input Box flaw?

[JonathanK1]

I have an input box that searches column 8. Ok, no problem. It pull
the data (copies it) and pastes it. Except that it's pasting some o
the wrong data/rows.

For example, the input box is year but when I enter the year (e.g.
2007), it copies the rows with 2007 in column 8 but also brings me bac
other years as well (2006 rows gets mixed in). Is there a way to kee
this from happening? it should only be searching row 8, not the othe
rows (and I can't see anything remotely close to these numbers in an
other cells anyway). It's not that helpful if it keeps doing this (an
it happens every single time I query).

(working.Cells(x,8).Value) = TheAnswer Then
working.Rows(x).EntireRow.Copy

Thanks

 

[Claus Busch]

Hi Jonathan,

Am Mon, 1 Apr 2013 10:45:08 +0000 schrieb JonathanK1:

For example, the input box is year but when I enter the year (e.g.,
2007), it copies the rows with 2007 in column 8 but also brings me back
other years as well (2006 rows gets mixed in). Is there a way to keep
this from happening? it should only be searching row 8, not the other
rows (and I can't see anything remotely close to these numbers in any
other cells anyway). It's not that helpful if it keeps doing this (and
it happens every single time I query).

filter column 8 by the answer, copy the visible cells

Sub Filter()
Dim Answer As Integer
Dim LRow As Long

With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Answer = Application.InputBox("Select a year", "Year", Type:=1)
If Answer = False Then Exit Sub

With .Range("A1:K" & LRow)
.AutoFilter Field:=8, Criteria1:=Answer
.SpecialCells(xlCellTypeVisible).Copy _
Sheets("Sheet2").Range("A1")
End With
.AutoFilterMode = False
End With
End Sub


Regards
Claus Busch

 

[GS]

Firstly, the InputBox does not copy/paste!

Secondly, the code sample you provided doesn't fit your explanation of
what you're trying to do. Please provide more details and all the
code...

--
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]

I have an input box that searches column 8. Ok, no problem. It pull
the data (copies it) and pastes it. Except that it's pasting some o
the wrong data/rows.

For example, the input box is year but when I enter the year (e.g.
2007), it copies the rows with 2007 in column 8 but also brings me bac
other years as well (2006 rows gets mixed in). Is there a way to kee
this from happening? it should only be searching row 8, not the othe
rows (and I can't see anything remotely close to these numbers in an
other cells anyway). It's not that helpful if it keeps doing this (an
it happens every single time I query).

(working.Cells(x,8).Value) = TheAnswer Then
working.Rows(x).EntireRow.Copy

Thanks.

Basically, is there a way to specifically exclude the other columns?
know it's only supposed to be searching column H (8), but it's obviousl
not. Would excluding the others specifically even help

 

[GS]

Basically, is there a way to specifically exclude the other columns?
I know it's only supposed to be searching column H (8), but it's
obviously not. Would excluding the others specifically even help?

This is doable! Please provide the code as asked for!

--
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]

How's this (below)? It opens perfectly in another workbook but when i
pulls by the input box (column H/8), it's bringing in rows tha
shouldn't be there. For example, if I enter 2007 for the year, 50 or s
rows will copy over that match my query....but a handful will be fro
2006. Isthere a way to keep it from doing that? It's pulling the data
want along with some data I DON'T want and didn't ask for. Strange. I
I can't fix this, it's not much good to me.

As always, I appreciate everyone's help.

---

Sub Button6_Click()

Dim TheAnswer As String

Dim working As Worksheet, dumping As Workbook

Set working = ActiveSheet

TheAnswer = LCase$(InputBox("Enter Year below"))

Set dumping = Workbooks.Add

For x = 1 To 17

working.Rows(x).EntireRow.Copy

dumping.Activate

ActiveSheet.Paste

ActiveCell.Offset(1).Select

Next

For x = 1 To working.Cells.SpecialCells(xlCellTypeLastCell).Row

If LCase$(working.Cells(x, 8).Value) = TheAnswer Then

working.Rows(x).EntireRow.Copy

dumping.Activate

ActiveSheet.Paste

ActiveCell.Offset(1).Select

End If

Next

Application.CutCopyMode = False

Cells.Sort Key1 etc. etc

 

[GS]

Ok, the 1st loop puts 17 rows (unconditionally) into the target wkb.
The 2nd loop puts only the rows that match your criteria in col8,
looping every row in the source wkb.

Paste this code into a standard module and call it from your
Button6_Click procedure like so...

Sub Button6_Click()
Call CopyYearData
End Sub

Sub CopyYearData()
Dim vData, vDataOut(), vAns, n&, j&, k#, lCols&, lNextRow&

vData = ActiveSheet.UsedRange: lCols = UBound(vData, 2)
vAns = Application.InputBox("Enter the year", Type:=1)
k = WorksheetFunction.CountIf(Columns(8), vAns)

ReDim vDataOut(1 To k, 1 To lCols) '//dimension the 2D output array
For n = LBound(vData) To UBound(vData)
If vData(n, 8) = vAns Then
lNextRow = lNextRow + 1
For j = 1 To lCols: vDataOut(lNextRow, j) = vData(n, j): Next 'j
End If 'vData(n, 8) = vAns
If lNextRow = k Then Exit For '//escape when done
Next 'n
Range("A10").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

 

[GS]

Oops.., I forgot you want to put the data in a new wkb. Revise as shown
below...

Sub CopyYearData()
Dim vData, vDataOut(), vAns, n&, j&, k#, lCols&, lNextRow&

vData = ActiveSheet.UsedRange: lCols = UBound(vData, 2)
vAns = Application.InputBox("Enter the year", Type:=1)
k = WorksheetFunction.CountIf(Columns(8), vAns)

ReDim vDataOut(1 To k, 1 To lCols) '//dimension the 2D output array
For n = LBound(vData) To UBound(vData)
If vData(n, 8) = vAns Then
lNextRow = lNextRow + 1
For j = 1 To lCols: vDataOut(lNextRow, j) = vData(n, j): Next
'j
End If 'vData(n, 8) = vAns
If lNextRow = k Then Exit For '//escape when done
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]

;1610930']Oops.., I forgot you want to put the data in a new wkb. Revis
as shown
below...-

Sub CopyYearData()
Dim vData, vDataOut(), vAns, n&, j&, k#, lCols&, lNextRow&

vData = ActiveSheet.UsedRange: lCols = UBound(vData, 2)
vAns = Application.InputBox("Enter the year", Type:=1)
k = WorksheetFunction.CountIf(Columns(8), vAns)

ReDim vDataOut(1 To k, 1 To lCols) '//dimension the 2D output array
For n = LBound(vData) To UBound(vData)
If vData(n, 8) = vAns Then
lNextRow = lNextRow + 1
For j = 1 To lCols: vDataOut(lNextRow, j) = vData(n, j): Next
'j
End If 'vData(n, 8) = vAns
If lNextRow = k Then Exit For '//escape when done
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

Thanks for the reply, Gary. Unfortunately, it doesn't copy or pull an
data now. It errors and highlights the "ReDim vDataOut" part of th
code. Could be something I'm doing wrong (I'm still learning) but
don't believe so. Hmm..

 

[GS]

;1610930']Oops.., I forgot you want to put the data in a new wkb.
Revise as shown
below...-

Sub CopyYearData()
Dim vData, vDataOut(), vAns, n&, j&, k#, lCols&, lNextRow&

vData = ActiveSheet.UsedRange: lCols = UBound(vData, 2)
vAns = Application.InputBox("Enter the year", Type:=1)
k = WorksheetFunction.CountIf(Columns(8), vAns)

ReDim vDataOut(1 To k, 1 To lCols) '//dimension the 2D output
array For n = LBound(vData) To UBound(vData)
If vData(n, 8) = vAns Then
lNextRow = lNextRow + 1
For j = 1 To lCols: vDataOut(lNextRow, j) = vData(n, j): Next
'j
End If 'vData(n, 8) = vAns
If lNextRow = k Then Exit For '//escape when done
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

Thanks for the reply, Gary. Unfortunately, it doesn't copy or pull
any data now. It errors and highlights the "ReDim vDataOut" part of
the code. Could be something I'm doing wrong (I'm still learning)
but I don't believe so. Hmm...

It works fine with the test data I used. Are any of the lines of code
missing or showing red?

--
Garry

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

 

[GS]

Also, take note that the source sheet MUST be the active sheet, AND
must contain data!!!

--
Garry

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

 

[GS]

Ok, here's a revised version that will handle *some* user
abuse/misuse...

Sub CopyYearData()
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 To lCols)
For n = LBound(vData) To UBound(vData)
If vData(n, lSearchCol) = vAns Then
lNextRow = lNextRow + 1
For j = 1 To lCols: vDataOut(lNextRow, j) = vData(n, j): Next
End If 'vData(n, 8) = vAns
If lNextRow = k 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

 

[Claus Busch]

Hi Jonathan,

Am Fri, 5 Apr 2013 10:48:31 +0000 schrieb JonathanK1:

Thanks for the reply, Gary. Unfortunately, it doesn't copy or pull any
data now. It errors and highlights the "ReDim vDataOut" part of the
code. Could be something I'm doing wrong (I'm still learning) but I
don't believe so. Hmm...

I tested Garry's code and it works fine. Please have a look at:
https://skydrive.live.com/#cid=9378AAB6121822A3&id=9378AAB6121822A3!191
for the workbook "Jonathan".
In SkyDrive macros are disabled. Therefore right-click and download the
workbook.
There are two buttons for two suggestions. They almost have the same
result. My suggestion also copies the header.


Regards
Claus Busch

 

[GS]

I tested Garry's code and it works fine. Please have a look at:

https://skydrive.live.com/#cid=9378AAB6121822A3&id=9378AAB6121822A3!191
for the workbook "Jonathan".
In SkyDrive macros are disabled. Therefore right-click and download
the
workbook.
There are two buttons for two suggestions. They almost have the same
result. My suggestion also copies the header.


Regards
Claus Busch

Hi Claus,
I was thinking there should be a header copying to a new wkb, but my
test data didn't have a Hdr_Row. I'd normally include this, of course,
since I'd usually (in this scenario) be writing this directly to a
delimited text file instead of a new wkb.

<FWIW>
Your code could do with toggling ScreenUpdating so that flicker doesn't
happen. Also, there seems to be a bit of delay using
AutoFilter/Copy/PasteSpecial. Nice to include the formatting, though.

--
Garry

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

 

[Claus Busch]

Hi Garry,

Am Fri, 05 Apr 2013 16:51:27 -0400 schrieb GS:

Your code could do with toggling ScreenUpdating so that flicker doesn't
happen. Also, there seems to be a bit of delay using
AutoFilter/Copy/PasteSpecial.

yes, I know. The fineness I let for Jonathan. I only upload to make a
workbook for Jonathan available. I also thought, that a misuse causes
the error.


Regards
Claus Busch

 

[GS]

Now includes header row...

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 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 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

 

[Claus Busch]

Hi Garry,

Am Fri, 05 Apr 2013 17:05:46 -0400 schrieb GS:

Now includes header row...

I changed it in the uploaded workbook. Thank you.


Regards
Claus Busch

 

[GS]

Hi Garry,

Am Fri, 05 Apr 2013 16:51:27 -0400 schrieb GS:


yes, I know. The fineness I let for Jonathan. I only upload to make a
workbook for Jonathan available. I also thought, that a misuse causes
the error.


Regards
Claus Busch

Jonathon might need some help with that, though. I just put code to
your macro to toggle ScreenUpdating and it works great, with no
perceivable delay now!

--
Garry

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

 

[GS]

Hi Garry,

Am Fri, 05 Apr 2013 17:05:46 -0400 schrieb GS:


I changed it in the uploaded workbook. Thank you.


Regards
Claus Busch

Did you copy/paste the entire procedure? If so, note that the button
_Click event needs to be updated with the new name for the sub. (I
appended "_v3" to it)

--
Garry

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

 

[Claus Busch]

Hi Garry,

Am Fri, 05 Apr 2013 17:18:46 -0400 schrieb GS:

Did you copy/paste the entire procedure? If so, note that the button
_Click event needs to be updated with the new name for the sub. (I
appended "_v3" to it)

I deleted "_v3" and put in the Screenupdating.


Regards
Claus Busch