PDA

View Full Version : Copy\Paste



sport1
05-03-2013, 11:58 AM
Hi
I am not a programmer and could use some help with what I have started.
The following.

1. Let the users select the applicable testing fields to be copied
2. Search for the value entered by the user in the dialogue box. The search should be done and active worksheet and worksheets in all workbooks within a directory.
3. Then Paste what was copied into the rows identified through the search

I was able to get the code to ask what range to copy, than a text box to enter value the value to search for. Finally it searches the active workbook and the directory.
I am having issues with the copy and paste feature.
Can you help me?

Thank you,
So Much
Sub Copy()
Dim ws As Worksheet
Dim rFound As Range
Dim strName As String
Dim doyou As String
Dim docopy$
Dim xArea As Range
Dim eArea As Range
Dim xData As Workbook
Dim xName$, ePath$
Dim fPicker As Object
Dim bsearch$
With Application
' .ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
docopy = MsgBox("Do you want to copy?", vbYesNo)
If docopy = vbYes Then
Set xArea = Application.InputBox(prompt:="Copy Area", Title:="Select Range", Type:=8)
Rem any select any worksheet And cell
strName = InputBox("Enter Cross Ref#")
If strName = "" Then Exit Sub
For Each ws In Worksheets
With ws.UsedRange
Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
If Not rFound Is Nothing Then
Application.Goto rFound, True
doyou = MsgBox("Do you want to continue searching?", vbYesNo)
If doyou = vbNo Then Exit Sub

End If
End With
Next ws
MsgBox "Value not found"
End If
doyou = MsgBox("Do you want to Search Directory?", vbYesNo)
If doyou = vbNo Then Exit Sub
Do
Set fPicker = Application.FileDialog(msoFileDialogFolderPicker)
With fPicker
.Show
ePath = .SelectedItems(1) & "\"
End With
xName = Dir(ePath & "*.xls*")
Do While Len(xName) > 0
Set xData = Workbooks.Open(ePath & xName)
For Each ws In Worksheets
With ws.UsedRange
Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
If strName = "" Then Exit Sub
If Not rFound Is Nothing Then
Application.Goto rFound, True
doyou = MsgBox("Do you want to continue searching?", vbYesNo)
If doyou = vbNo Then Exit Sub

End If

End With
Next ws
xData.Close False
xName = Dir
Loop
bsearch = MsgBox("Value not found, do you want to search another directory?", vbYesNo)
Loop Until bsearch = vbNo
With Application
' .ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True

End With

MsgBox "Value not found"
End Sub

mdmackillop
05-03-2013, 12:21 PM
Please use the green VBA button to format text as shown

mdmackillop
05-03-2013, 12:31 PM
Please confirm this is what you want to do:
If rFound is not nothing then copy xArea.
If so, to where is it copied?

BTW, Code comments would help in following your steps.

sport1
05-06-2013, 06:22 AM
Please confirm this is what you want to do:
If rFound is not nothing then copy xArea.
If so, to where is it copied?

BTW, Code comments would help in following your steps.


The information that you are sking me sound right. But again I am learning all this.

I have attached kind of an example

So here is what I am trying to do.

1. The user would find the Cross Reference number that they would consider to be a duplicate (S.1.1-01)
2. Run the code to copy the range of cells. (which the code is doing right now just fine).
3. Next a textbox would come up asking the user to enter the Cross Reference Number that they would like to do a search for. The search would than check the current active workbook for that information and if found the user would be ask If they want to past the information on that sheet (Yes/No).
4. If they would have the option to continue the search either on that worksheet or select a directory to search other workbooks in the directory. Again same scenario if Cross Reference found do they want to paste it in that sheet or continue searching.

The problem I am having at the moment is the past code. I am just not sure how to write it to work. Again I am not a VBA coder. So yes any help would be great!!

[QUOTE]
Sub Copy()
Dim ws As Worksheet
Dim rFound As Range
Dim strName As String
Dim doyou As String
Dim docopy$
Dim xArea As Range
Dim eArea As Range
Dim xData As Workbook
Dim xName$, ePath$
Dim fPicker As Object
Dim bsearch$
With Application
' .ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
docopy = MsgBox("Do you want to copy?", vbYesNo)
If docopy = vbYes Then
Set xArea = Application.InputBox(prompt:="Copy Area", title:="Select Range", Type:=8)
Rem any select any worksheet And cell
strName = InputBox("Enter Cross Ref#")
If strName = "" Then Exit Sub
For Each ws In Worksheets
With ws.UsedRange
Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
If Not rFound Is Nothing Then
Application.Goto rFound, True
doyou = MsgBox("Do you want to continue searching?", vbYesNo)
If doyou = vbNo Then Exit Sub

End If
End With
Next ws
MsgBox "Value not found"
End If
doyou = MsgBox("Do you want to Search Directory?", vbYesNo)
If doyou = vbNo Then Exit Sub
Do
Set fPicker = Application.FileDialog(msoFileDialogFolderPicker)
With fPicker
.Show
ePath = .SelectedItems(1) & "\"
End With
xName = Dir(ePath & "*.xls*")
Do While Len(xName) > 0
Set xData = Workbooks.Open(ePath & xName)
For Each ws In Worksheets
With ws.UsedRange
Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
If strName = "" Then Exit Sub
If Not rFound Is Nothing Then
Application.Goto rFound, True
doyou = MsgBox("Do you want to continue searching?", vbYesNo)
If doyou = vbNo Then Exit Sub

End If

End With
Next ws
xData.Close False
xName = Dir
Loop
bsearch = MsgBox("Value not found, do you want to search another directory?", vbYesNo)
Loop Until bsearch = vbNo
With Application
' .ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True

End With

MsgBox "Value not found"
End Sub


Thank You,

sport1
05-07-2013, 10:30 AM
Hi again can someone help me with the above request for copy/and paste.
I am new at this and just not sure how to get the paste to work.
And I am sorry about not adding comments to the code but like I said I really am trying to learn this

thanks:hi: