JonathanK1;1610807 Wrote:
I have an input box that searches column 8. Ok, no problem. It
pulls the data (copies it) and pastes it. Except that it's pasting
some of 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
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).

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

Thanks.

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

How's this (below)? It opens perfectly in another workbook but when it pulls by the input box (column H/8), it's bringing in rows that shouldn't be there. For example, if I enter 2007 for the year, 50 or so rows will copy over that match my query....but a handful will be from 2006. Isthere a way to keep it from doing that? It's pulling the data I want along with some data I DON'T want and didn't ask for. Strange. If 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.

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

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

'GS[_2_ Wrote:
;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

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

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

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=9378A...121822A3%21191
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
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

I tested Garry's code and it works fine. Please have a look at:
https://skydrive.live.com/#cid=9378A...121822A3%21191
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

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