VBA Macro - Copying specific data to different sheets in a workbookand linking the InputBox to a com

S

srsev6

Currently I am using a vba code to pull the data from one sheet in a workbook to another sheet based on the name I type in the input box. Unfortunately, this will only work for copying the data to one sheet. For instance, when I want to change the name and pull the data based on that name it will be added to the same sheet as the previous information.

This leaves me with two questions:

1. How can I pull data for each name and have the data copy to a differentsheet for each name? (For instance, if I enter "Bob" in the InputBox, I want the information for "Bob" to copy the sheet labeled "Bob". Then, I want to enter the name "Tina" and have Tina's information copied to the sheet labeled "Tina" and so on).

2. How can I link the InputBox below to a command button so others can quickly access the inputbox to enter the name.

If you need my spreadsheet to view the code please let me know.

Sub CopyData()
Application.ScreenUpdating = False
Dim name As String
name = InputBox("Please enter name to search.")
Dim bottomD As Integer
bottomD = Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row
Dim c As Range
For Each c In Sheets("Sheet1").Range("D2:D" & bottomD)
If c = name And c.Offset(0, 1) <= Date And c.Offset(0, 3) = "" Then
Range(Cells(c.Row, 1), Cells(c.Row, 5)).Copy Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next c
Application.ScreenUpdating = True
End Sub

Thank you so much for your time. It is greatly appreciated.
 
G

GS

Try...

Sub CopyData2()
Application.ScreenUpdating = False
Dim vCriteria, lLastRow&, c As Range

vCriteria = Split(InputBox("Please enter name to search, and sheet to
copy to, separated by a comma."), ",")
lLastRow = Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row
With Sheets("Sheet1")
For Each c In .Range("D2:D" & lLastRow)
If c = vCriteria(0) _
And c.Offset(0, 1) <= Date _
And c.Offset(0, 3) = "" Then
.Range(Cells(c.Row, 1), Cells(c.Row, 5)).Copy _
Sheets(vCriteria(1)).Cells(Rows.Count, _
"A").End(xlUp).Offset(1, 0)
End If
Next 'c
End With 'Sheets("Sheet1")
Application.ScreenUpdating = True
End Sub 'CopyData2

--
Garry

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

isabelle

hi srsev6,

first of all, it is not permitted to use a variable name (name) already
used by Excel,
you can replace "name" with "sname"

and then replace

Range(Cells(c.Row, 1), Cells(c.Row, 5)).Copy
Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

by

Range(Cells(c.Row, 1), Cells(c.Row, 5)).Copy
Sheets(sname).Cells(Sheets(sname).Rows.Count, "A").End(xlUp).Offset(1, 0)

isabelle
 
G

GS

isabelle formulated on Friday :
first of all, it is not permitted to use a variable name (name)
already used by Excel
Click to expand...

That's not exactly true. If you said it's not 'good practice' to use a
variable name that's also used as an object's name by Excel then I
would not have any issue...

Dim name As String
name = "Isabelle"
Debug.Print name

...runs without objection from VBA/Excel. How (by what authority), then,
is it "not permitted" to use this as a variable name since VBA/Excel
seem to have no objection?

--
Garry

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

srsev6

isabelle formulated on Friday :





That's not exactly true. If you said it's not 'good practice' to use a

variable name that's also used as an object's name by Excel then I

would not have any issue...



Dim name As String

name = "Isabelle"

Debug.Print name



..runs without objection from VBA/Excel. How (by what authority), then,

is it "not permitted" to use this as a variable name since VBA/Excel

seem to have no objection?



--

Garry



Free usenet access at http://www.eternal-september.org

Classic VB Users Regroup!

comp.lang.basic.visual.misc

microsoft.public.vb.general.discussion
Click to expand...

Thank you all for your input. All of it was extremely helpful. I was able to take the information provided by all of you and come up with the following that works perfectly:

Sub CopyData()
Application.ScreenUpdating = False
Dim name As String
name = "Tina"
Debug.Print name
Dim bottomD As Integer
bottomD = Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row
Dim c As Range
For Each c In Sheets("Sheet1").Range("D2:D" & bottomD)
If c = name And c.Offset(0, 1) <= Date And c.Offset(0, 3) = "" Then
Range(Cells(c.Row, 1), Cells(c.Row, 5)).Copy Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next c
Application.ScreenUpdating = True
name = "Bill"
Debug.Print name
bottomD = Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row
For Each c In Sheets("Sheet1").Range("D2:D" & bottomD)
If c = name And c.Offset(0, 1) <= Date And c.Offset(0, 3) = "" Then
Range(Cells(c.Row, 1), Cells(c.Row, 5)).Copy Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next c
Application.ScreenUpdating = True
name = "Diane"
Debug.Print name
bottomD = Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row
For Each c In Sheets("Sheet1").Range("D2:D" & bottomD)
If c = name And c.Offset(0, 1) <= Date And c.Offset(0, 3) = "" Then
Range(Cells(c.Row, 1), Cells(c.Row, 5)).Copy Sheets("Sheet4").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next c
Application.ScreenUpdating = True
End Sub
 
G

GS

Glad you have a working solution! I'm certain, though, that you'd be
much better off without the repetitious code, maintenance-wise, as my
sample demonstrates.<g>

You can modify my sample to reflect a simple 'mapping' mechanism you
could use to align the names/sheetnames...

Sub CopyData3()
Application.ScreenUpdating = False
Dim vNames, vSheets, lLastRow&, n&, c As Range
Const sNames$ = "Tina,Bill,Diane"
Const sSheets$ = "Sheet2,Sheet3,Sheet4"

vNames = Split(sNames, ","): vSheets = Split(sSheets, ",")
lLastRow = Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row
With Sheets("Sheet1")
For n = LBound(vNames) To UBound(vNames)
For Each c In .Range("D2:D" & lLastRow)
If c = vNames(n) And c.Offset(0, 1) <= Date _
And c.Offset(0, 3) = "" Then
.Range(Cells(c.Row, 1), Cells(c.Row, 5)).Copy _
Sheets(vSheets(n)).Cells(Rows.Count, _
"A").End(xlUp).Offset(1, 0)
End If 'c = vNames(n)
Next 'c
Next 'n
End With 'Sheets("Sheet1")
Application.ScreenUpdating = True
End Sub 'CopyData3

--
Garry

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

srsev6

Glad you have a working solution! I'm certain, though, that you'd be

much better off without the repetitious code, maintenance-wise, as my

sample demonstrates.<g>



You can modify my sample to reflect a simple 'mapping' mechanism you

could use to align the names/sheetnames...



Sub CopyData3()

Application.ScreenUpdating = False

Dim vNames, vSheets, lLastRow&, n&, c As Range

Const sNames$ = "Tina,Bill,Diane"

Const sSheets$ = "Sheet2,Sheet3,Sheet4"



vNames = Split(sNames, ","): vSheets = Split(sSheets, ",")

lLastRow = Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row

With Sheets("Sheet1")

For n = LBound(vNames) To UBound(vNames)

For Each c In .Range("D2:D" & lLastRow)

If c = vNames(n) And c.Offset(0, 1) <= Date _

And c.Offset(0, 3) = "" Then

.Range(Cells(c.Row, 1), Cells(c.Row, 5)).Copy _

Sheets(vSheets(n)).Cells(Rows.Count, _

"A").End(xlUp).Offset(1, 0)

End If 'c = vNames(n)

Next 'c

Next 'n

End With 'Sheets("Sheet1")

Application.ScreenUpdating = True

End Sub 'CopyData3



--

Garry



Free usenet access at http://www.eternal-september.org

Classic VB Users Regroup!

comp.lang.basic.visual.misc

microsoft.public.vb.general.discussion
Click to expand...

I completely agree with you GS. The code you provided would be more efficient in maintaining however, when I put the code in my actual spreadsheet with the named sheets it didn't seem to work. I changed the names that are incolumn D on the original spreadsheet and changed "Sheet1, Sheet2, etc" to the name of the actual sheets and it didn't seem to work properly. The codeI provided was the fastest way to get it working at the time for the end users to be able to start using the tool. So I used the one I posted.

However, after a good night sleep and reviewing your code in my atual worksheet with my changes, I realized the errors I had made and now the code youprovided is being used.

Thanks GS.
 
G

GS

I completely agree with you GS. The code you provided would be more
efficient in maintaining however, when I put the code in my actual
spreadsheet with the named sheets it didn't seem to work. I changed
the names that are in column D on the original spreadsheet and
changed "Sheet1, Sheet2, etc" to the name of the actual sheets and it
didn't seem to work properly. The code I provided was the fastest way
to get it working at the time for the end users to be able to start
using the tool. So I used the one I posted.

However, after a good night sleep and reviewing your code in my atual
worksheet with my changes, I realized the errors I had made and now
the code you provided is being used.

Thanks GS.
Click to expand...

A good night's sleep is a great thing! It works wonders for me too...

Glad you were able to get it working. It makes sense to me, though, to
name the target sheets same as the person's name so you only have 1
list to maintain, and you can use the same array element for both parts
of the loop...

Sub CopyData4()
Application.ScreenUpdating = False
Dim vNames, lLastRow&, n&, c As Range
Const sNames$ = "Tina,Bill,Diane"

vNames = Split(sNames, ","): vSheets = Split(sSheets, ",")
lLastRow = Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row
With Sheets("Sheet1")
For n = LBound(vNames) To UBound(vNames)
For Each c In .Range("D2:D" & lLastRow)
If c = vNames(n) And c.Offset(0, 1) <= Date _
And c.Offset(0, 3) = "" Then
.Range(Cells(c.Row, 1), Cells(c.Row, 5)).Copy _
Sheets(vNames(n)).Cells(Rows.Count, _
"A").End(xlUp).Offset(1, 0)
End If 'c = vNames(n)
Next 'c
Next 'n
End With 'Sheets("Sheet1")
Application.ScreenUpdating = True
End Sub 'CopyData4

--
Garry

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

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro VBA coding, Copying content from one workbook to a new one 0
Copy Data from One sheet to Different Sheets 1
Array with many cells from a row but not in order or together 11
VBA - exporting serial letters to single documents 0
InputBox for column letter problem 2
InputBox to name a range 2
A simple if <> nn then Msgbox "No Match" 5
Loop returns only one value, does not loop & an assignment to columnhow-to problem. 26

Top