Selected row--->other workbook?

Chee Johnske!!!!
It looks like it works!!!!!! Let me check!!! It seems I run out of black ink, that's why...:mkay I'll check it...

First problem I noticed, it will print 1 copy but 6 sheets... How to put that there?? Allways a new problem....

I have another stupid ? again...

Is there a way to but this code not to searh the Temp, it gets searching and searcing again... (loop?):wot

Code:

---

Private Sub CommandButton1_Click()
Dim oSheet As Object
Dim Firstcell As Range
Dim NextCell As Range
Dim WhatToFind As Variant
Dim rCopyCells As Range
On Error GoTo Err
Application.ScreenUpdating = False
    Sheets("Temp").Select
    Range("B2:B50").Select
    Selection.ClearContents
    Sheets("Vero").Select
Application.ScreenUpdating = True
WhatToFind = Application.InputBox("Search!", "Etsi", , 100, 100, , , 2)
If WhatToFind = False Then
Sheets("Vero").Select
End
End If
If WhatToFind <> "" And Not WhatToFind = False Then
For Each oSheet In ActiveWorkbook.Worksheets
oSheet.Activate
oSheet.[a1].Activate
Set Firstcell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not Firstcell Is Nothing Then
Firstcell.Activate
If MsgBox("Add Record", vbInformation + vbYesNo) = vbYes Then
ActiveCell.Select
Selection.EntireRow.Copy Destination:= _
Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)
Set rCopyCells = Nothing
End If
On Error Resume Next
While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address)
Set NextCell = Cells.FindNext(After:=ActiveCell)
If Not NextCell.Address = Firstcell.Address Then
NextCell.Activate
If MsgBox("Add Record", vbInformation + vbYesNo) = vbYes Then
ActiveCell.Select
Selection.EntireRow.Copy Destination:= _
Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)
End If
End If
Wend
End If
Set NextCell = Nothing
Set Firstcell = Nothing
Next oSheet
End If
Application.ScreenUpdating = False
 Sheets("Temp").Select
 Range("A2,AA1300").Select
 Application.ScreenUpdating = True
 Sheets("Vero").Select
 Sheets("Temp").Copy
 End
Err:
MsgBox "An error!Try again!!"
End
End Sub

---

Hi erin,

1st things 1st... If you look at the destination for your data you'll see that you have data going to Range("BF2").

Now, Go to sheet "Taul2". If you look at this sheet in "Page Break Preview" (Go to "View" and select "Page Break Preview"), the blue lines that mark out the page area that will be printed extend out to column BF (which is exactly where you've said the data is to go to) and this is also marked as "page 6" in page break preview.

You need to sort out the destination (in the code module) so that the data goes only to the fields that are marked out on Page 1.

I dont know exactly what's going from where to where as the headings on Page 1 of Taul2 are 1) not in english and 2) the sheet that the data is coming from has no data on it anyway. So I'm unable to say "Oh yes, that's their 1st name, that should be going to there, and that's their 2nd name and that should be going here" - so, sorry, you will have to sort that out yourself...
:think:

Now, I'm only guessing here, but I think you may have the source and destination completely reversed, but, as I said, you (or someone else that can read your language) are the only one that can check if this is correct...Try this:

Code:

---

Sub CopyAndPrint()
Dim Wkb As Workbook
Dim WS As Worksheet
Dim ThisBook
Dim i As Long
Set Wkb = Workbooks("Veroinsiirto.xls")
Set WS = Wkb.Sheets("Taul2")
Set ThisBook = ThisWorkbook.Sheets("Sheet1")
Application.ScreenUpdating = False
WS.Range("R1:BD2").ClearContents 'only need this once
For i = Selection(1, 1).Row To Selection(1, 1).Row + Selection.Rows.Count - 1
'DESTINATION                    SOURCE
WS.Range("H8") = ThisBook.Range("AO2")
WS.Range("D10") = ThisBook.Range("AO2")
WS.Range("A2") = ThisBook.Range("BB2")
WS.Range("J2") = ThisBook.Range("BB2")
WS.Range("A6") = ThisBook.Range("A2")
WS.Range("J6") = ThisBook.Range("B2")
WS.Range("A16") = ThisBook.Range("Z2")
WS.Range("J16") = ThisBook.Range("AZ2")
WS.Range("M16") = ThisBook.Range("AA2")
WS.Range("A23") = ThisBook.Range("BD2")
WS.Range("J23") = ThisBook.Range("BE2")
WS.Range("M23") = ThisBook.Range("BF2")
WS.Range("D36") = ThisBook.Range("AV2")
WS.PrintOut copies:=6
Next i
Wkb.Close SaveChanges:=False
Set WS = Nothing
Set Wkb = Nothing
Set ThisBook = Nothing
End Sub

---

Note, also, before trying this, go to the sheet "Taul2" and drag the Bottom Border of the page break preview 2 rows down and save.

YES!!!!
Except it doesn't print anymore all the rows, only the first one....

THANKS and KIsses!!!:bow:

Quote:

---

Originally Posted by erin64

YES!!!!
Except it doesn't print anymore all the rows, only the first one....

THANKS and KIsses!!!:bow:

---

You mean only the first row from the source? It still prints the page Taul2 doesn't it?

Yes it prints the right part of the right sheet on the right workbook with right data on it:beerchug: ,

but only the first row from the target... all the data from source is in it..



edit:
I'll put the accurate code here, it's easier to see what I've messed again:

Code:

---

Sub SearchandCopy()
Dim oSheet As Object
Dim Firstcell As Range
Dim NextCell As Range
Dim WhatToFind As Variant
Dim rCopyCells As Range
On Error GoTo Err
Application.ScreenUpdating = False
    Sheets("Temp").Select
    Range("A2:D1000").Select
    Selection.ClearContents
    Sheets("Vero").Select
Application.ScreenUpdating = True
WhatToFind = Application.InputBox("Kirjoita nimi?", "Etsi", , 100, 100, , , 2)
If WhatToFind = False Then
Sheets("Vero").Select
End
End If
If WhatToFind <> "" And Not WhatToFind = False Then
For Each oSheet In ActiveWorkbook.Worksheets
oSheet.Activate
oSheet.[a1].Activate
Set Firstcell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not Firstcell Is Nothing Then
Firstcell.Activate
If MsgBox("Add Record", vbInformation + vbYesNo) = vbYes Then
ActiveCell.Select
Selection.EntireRow.Copy Destination:= _
Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)
Set rCopyCells = Nothing
End If
On Error Resume Next
While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address)
Set NextCell = Cells.FindNext(After:=ActiveCell)
If Not NextCell.Address = Firstcell.Address Then
NextCell.Activate
If MsgBox("Add Record", vbInformation + vbYesNo) = vbYes Then
ActiveCell.Select
Selection.EntireRow.Copy Destination:= _
Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)
End If
End If
Wend
End If
Set NextCell = Nothing
Set Firstcell = Nothing
Next oSheet
End If
Application.ScreenUpdating = False
 Sheets("Temp").Select
 Range("A2,AA1300").Select
 Application.ScreenUpdating = True
 Sheets("Vero").Select
 Sheets("Temp").Copy
 End
Err:
MsgBox "Sorry, virhe. Yrit? uudelleen!"
End
End Sub

---

Quote:

---

Originally Posted by erin64

Yes it prints the right part of the right sheet oh the right workbook with right data on it:beerchug: ,

but only the first row from the target... all the data from source is in it..

---

OK, seeing we've established that all the source data starts from row 2, try this variation:

Code:

---

Sub CopyAndPrint()
      Dim Wkb As Workbook
      Dim WS As Worksheet
      Dim ThisBook
      Dim i As Long
Set Wkb = Workbooks("Veroinsiirto.xls")
      Set WS = Wkb.Sheets("Taul2")
      Set ThisBook = ThisWorkbook.Sheets("Sheet1")
      Application.ScreenUpdating = False
      WS.Range("R1:BD2").ClearContents
      i = 2
      Do Until ActiveCell = Empty
            Range("A" & i).Select  '< need something in A2 (at least)
            'DESTINATION                        SOURCE
            WS.Range("A6") = ThisBook.Range("A" & i)
            WS.Range("J6") = ThisBook.Range("B" & i)
            WS.Range("A16") = ThisBook.Range("Z" & i)
            WS.Range("M16") = ThisBook.Range("AA" & i)
            WS.Range("H8") = ThisBook.Range("AO" & i)
            WS.Range("D10") = ThisBook.Range("AO" & i)
            WS.Range("D36") = ThisBook.Range("AV" & i)
            WS.Range("J16") = ThisBook.Range("AZ" & i)
            WS.Range("A2") = ThisBook.Range("BB" & i)
            WS.Range("J2") = ThisBook.Range("BB" & i)
            WS.Range("A23") = ThisBook.Range("BD" & i)
            WS.Range("J23") = ThisBook.Range("BE" & i)
            WS.Range("M23") = ThisBook.Range("BF" & i)
            WS.PrintOut copies:=6
            i = i + 1
      Loop
      Wkb.Close SaveChanges:=False
      Set WS = Nothing
      Set Wkb = Nothing
      Set ThisBook = Nothing
End Sub

---

OOPS! Sorry did that too fast, change [vba]Range("A" & i).Select '< need something in A2 (at least)[/vba]

to:[vba]ThisBook.Range("A" & i).Select '< need something in A2 (at least)[/vba]

From the other piece code you gave, I'm not entirely sure what the intent is... but I assume that once a name is found and one thing is done you don't want to do anything else with that name and you want to go on to the next name and not keep looping.

let me know whether this is doing what you intend to do, if not, it can be easily modified to do it:

Code:

---

Sub Button1_Click()
      Dim oSheet As Object
      Dim FindName As Range
      Dim NextCell As Range
      Dim NameToFind As Variant
      Dim rCopyCells As Range
      Dim Addit As Variant
      On Error GoTo Err
      Application.ScreenUpdating = False
      Sheets("Temp").Select
      Range("A2:D1000").Select
      Selection.ClearContents
      Sheets("Vero").Select
      Application.ScreenUpdating = True
      NameToFind = Application.InputBox("Kirjoita nimi?", "Etsi", , 100, 100, , , 2)
      If NameToFind = Empty Then
            Sheets("Vero").Select
            End
      End If
      If NameToFind <> Empty Then
            For Each oSheet In ActiveWorkbook.Worksheets
                  oSheet.Activate
                  oSheet.Range("A1").Activate
                  Set FindName = Cells.Find(What:=NameToFind, LookIn:=xlValues, LookAt _
                                                                                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                  If FindName Is Nothing Then
                        GoTo Err
                  Else
                        FindName.Activate
                        Addit = MsgBox("Add Record?", vbInformation + vbYesNo)
                        If Addit = vbYes Then
                              ActiveCell.Select
                              Selection.EntireRow.Copy Destination:= _
                                                      Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)
                              Exit Sub
                        End If
                        On Error Resume Next
                        Set NextCell = Cells.FindNext(After:=ActiveCell)
                        Do
                              NextCell.Activate
                              Addit = MsgBox("Add Record?", vbInformation + vbYesNo)
                              If Addit = vbYes Then
                                    Selection.EntireRow.Copy Destination:= _
                                                            Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)
                                    Exit Sub
                              End If
                        Loop Until NextCell Is Nothing Or NextCell.Address = FindName.Address
                  End If
                  Set NextCell = Nothing
                  Set FindName = Nothing
            Next oSheet
      End If
      Application.ScreenUpdating = False
      Sheets("Temp").Select
      Range("A2,AA1300").Select
      Application.ScreenUpdating = True
      Sheets("Vero").Select
      Sheets("Temp").Copy
      End
Err:
      MsgBox "Sorry, virhe. Yrit? uudelleen!"
      End
End Sub

---

Quote:

---

Originally Posted by johnske

From the other piece code you gave, I'm not entirely sure what the intent is... but I assume that once a name is found and one thing is done you don't want to do anything else with that name and you want to go on to the next name and not keep looping.

---

By that I mean that I'm assuming that there's only one entry for each person, right? Or may there be more than one entry? (PS: what I gave could probably also be cleaned up some more)

Hi there, can't try it now, but the meaning is that you enter the name, the alien searches the whole column Z at Sheet1, user can accept, or deny the selection, if added, it stores it into Temp sheet. Temp will be saved and printedor sometimes added to another workbook sometimes, but not allways. The temp can be cleared...

Thanks for working this puzzle out with me:friends:

-erin-

Hi erin,

Up till now I haven't been able to properly test what I've given you cause my printer had problems. I just got it going...

There were a couple of issues that've been sorted out now in the new code below.

Also, I added something....I assume once you have printed the 6 copies, you have no further need of the names on Sheet1, so now every time the printing is finished for each row, that row is deleted (otherwise those names would be re-printed each time you ran this):

Code:

---

Sub CopyAndPrint()
Dim Wkb As Workbook
Dim WS As Worksheet
Dim ThisBook
Dim i As Long
Set Wkb = Workbooks("Veroinsiirto.xls")
Set WS = Wkb.Sheets("Taul2")
Set ThisBook = ThisWorkbook.Sheets("Sheet1")
Application.ScreenUpdating = False
i = 2
Do
ThisBook.Range("A" & i).Select
'DESTINATION SOURCE
WS.Range("A6") = ThisBook.Range("A" & i)
WS.Range("J6") = ThisBook.Range("B" & i)
WS.Range("A16") = ThisBook.Range("Z" & i)
WS.Range("M16") = ThisBook.Range("AA" & i)
WS.Range("H8") = ThisBook.Range("AO" & i)
WS.Range("D10") = ThisBook.Range("AO" & i)
WS.Range("D36") = ThisBook.Range("AV" & i)
WS.Range("J16") = ThisBook.Range("AZ" & i)
WS.Range("A2") = ThisBook.Range("BB" & i)
WS.Range("J2") = ThisBook.Range("BB" & i)
WS.Range("A23") = ThisBook.Range("BD" & i)
WS.Range("J23") = ThisBook.Range("BE" & i)
WS.Range("M23") = ThisBook.Range("BF" & i)
WS.PrintOut copies:=6
ActiveCell.Rows.EntireRow.ClearContents
ActiveCell.Offset(1, 0).Select
i = i + 1
Loop Until ActiveCell = Empty
Wkb.Close SaveChanges:=False
Set WS = Nothing
Set Wkb = Nothing
Set ThisBook = Nothing
End Sub

---

I'll be busy for about 12 hours so I won't be able to get to have a proper look at the other part till then...:beerchug:

Hi erin,

Have a little time now, but first (have been reading back through the earliest posts) - some questions before I can get started, (I know English is not your 1st language, but please try to answer these as best you can)....

1) Is all your source data going to be on one sheet, i.e. the sheet "vero"?

2) I assume this source data on Vero is to be a permanent or semi-permanent record - correct?

3) Is there only one row of data on Vero relating to each persons name?

3) Do we really need to copy from a) the sheet Vero to the temp sheet, then b) from vero to sheet1, and then have to clear both vero and the temp sheet? - (I don't see that this is essential) - Could we not just transfer it to sheet1, print and clear each row one at a time till all have been done? OR
Do you need this other copy so you can refer to it and say "it's been done" which, it seems, is not what your other macro is doing at present (I'm asking this is because in your Button1_Click macro you have "Sheets("Temp").Select: Range("A2: D1000").ClearContents" - this clears the Temp sheet every time you look for a new name(?))

4) When we are searching Vero for data to be printed, what is the column we searching through for the data? (I assume this column would contain their primary, or "sur"-name).

5) When there are two or more people with the same primary name, how do you want to be able to determine which of these is the one you want to print?...we could do this several ways

A) List their primary name (and perhaps several other things that could uniquely identify them) in a message box asking if you want to add them to the list to be printed.... If you want to use other identifiers, which columns would they be in? - or

B) Probably not as good - we could select (highlight) the row that contains all their data



EDIT: Sorry that this is taking longer than it should erin, but, apart from simple language differences etc., your workbooks (that I'm working from) give error messages very frequently on things that are generally regarded as "good coding practice" and that will work instantly in another workbook. In addition, these error messages are not the "normal" type of error message that (usually) give you the option to debug - they're just message boxes with an error number in them.

I don't know why this is so :dunno whether it's a corrupt workbook (I doubt it) or because it's simply as different language version of office. In any case, I'm just trying to "work around it" - simply trying to find things that WILL work in your workbook.

This is probably why everyone has been having problems helping you... :)

John

Hi John,

Sorry I haven't been able to answer earlier, but had to go to work yesterday, then my father had a hheart attack, so I was in hospital with him. No opening this thread made me almost cry to find out how much time and effort You are putting into solving this. Can't ever thank you enough!

Sorry about my english. It's bad and speaking about computer related issues don't make it better.:(

I'll explain the whole thing as simply as I can:

In workbook 1 I have three sheets. Worksheet1 and worksheet2(Vero) have customer registries.These two are identical in columns, but have different data. They may have same customers. And same customer may be many times in both sheet.


Column Z is customers name, but it can be in whatever mode(?). I mean there can be surname, second name and first name. Or just one of these. Can be written in capitals or not (not my fault: the register was bought by my boss so). But that is the only volumn that will identify the customer.

So now that we have found the customer, i need to pick the data conserning him,maybe add things or change it, add it to Temp(Sheet3). Then find next and so on. When I have all the customers I want in Temp, I need to but some of that information n workbook 2(Veroinsiirto). Then print 6 copies of each customer. I actually need that data in workbook1, Temp to be added in Workbook3 at the same shape it is in Temp, then I don't need it in Worbook1/Temp anymore. It can be cleared. Haven't been thinking the move in the Workbook3 yet.

I tried to run this in my working place yesterday and the search part went ok. Running the code CopyAndPrint() gave an error message Error in loading DLL.Error 48. And System Error &H8004005(-2147467259). What was that? Different version? The one I'm using is XP, at work I'm not sure, but I think 2000.

Starting to test your work now...

Thanks again, milllion times. You are an angel!

-erin-:hi:

Quote:

---

Originally Posted by erin64

I tried to run this in my working place yesterday and the search part went ok. Running the code CopyAndPrint() gave an error message Error in loading DLL.Error 48. And System Error &H8004005(-2147467259). What was that? Different version? The one I'm using is XP, at work I'm not sure, but I think 2000.

---

Hi erin, really sorry to hear about your father, I hope he's on the mend now...

As for the last part, we really have to sort this out first... is CopyAndPrint running OK on your home computer, but not on the work computer? I have office 2000 running on Win98SE and its working perfectly on mine (only difference is I set the number of print copies to 1 instead of 6 to save ink :devil: )



PS: (Whether their name's in capitals or not doesn't present a problem)

Hi there,
Just tested it at home.Does find the info ,put from one line prints hundreds of copies....
By the way, have You a MSN messenger?

And it doesn't save the info in temp if I add a new customer... I was thinking to make all the addings at one click...
:eek: :think:

Quote:

---

Originally Posted by erin64

And it doesn't save the info in temp if I add a new customer... I was thinking to make all the addings at one click...
:eek: :think:

---

OK, if you read my previous posting, that's what your code says to do, all I did with it was try to tidy it a bit and fixed it to get out of the infinite loop.

I have an idea that I've done a brief bit of code for that I'd like you to try, however, I'm now beginning to suspect your workbook may have become corrupted somewhere along the line.

No, I don't have Yahoo, I uninstalled it the other night. If you PM (private message) me your email address (click my name to PM me), I'll copy this code into a new workbook, zip it and email it and get you to try it in the new book to see if you're still having problems - if everything goes OK, we can then continue the thread on from there.

Hi there!
With the great help of You all, I'm glad to be able to announce:Problem solved!

Especially I want to thank John for doing all the work for me!!!:bow: You are an angel! Thank You!:kiss

I'll be back with more problems!!!

-erin-:beerchug:

Glad to hear that erin.

Do you know you can mark your thread Solved? Go to Thread tools to do that.

For those following this thread, one of the major hurdles appeared to be a corrupt workbook. The last code used (using actual emailed data & returned in an uncorrupted book by PM) was this:

Code:

---

Option Compare Text
Option Explicit
 
Sub Button1_Click()
Dim NameToFind As Variant
Dim Cell As Range
Dim Addit As VbMsgBoxResult
Dim AnyMore As VbMsgBoxResult
Dim Counter%
Sheets("Vero").Activate
Application.ScreenUpdating = False
NameToFind = Application.InputBox("Kirjoita nimi?", "Etsi", , 100, 100, , , 2)
If NameToFind = Empty Then
GoTo Finish
Else
Counter = 0
For Each Cell In Range("Z2:Z2000")
If Cell Like "*" & NameToFind & "*" Then '<< use "Like" for wildcards in If-Then statements
Addit = MsgBox("Add Record? ( " & Cell & " )", _
vbYesNo, "Is this record to be printed?")
Counter = Counter + 1
If Addit = vbYes Then
Cell.Select
Selection.EntireRow.Copy Destination:=Sheets _
("Sheet1").Range("A65536"). _
End(xlUp).Offset(1, 0)
End If
End If
Next Cell
End If
If Counter = 0 Then MsgBox "Sorry, no " & NameToFind & "s found", _
vbOKOnly, NameToFind & " Not Found"
AnyMore = MsgBox("Add more names?", vbYesNo, "Any More?")
If AnyMore = vbYes Then
Button1_Click
Else
Sheets("Sheet1").Activate
Application.ScreenUpdating = True
End If
Exit Sub
Finish:
MsgBox "sorry, no " & NameToFind & "s found", vbOKOnly, NameToFind & " Not Found"
Sheets("Temp").Activate
End Sub
 
'//This function by Joseph Ruben is used to find if a workbook's already open
Function WorkbookIsOpen(WorkBookName As String) As Boolean
'//Returns TRUE if the workbook is open
WorkbookIsOpen = False
On Error GoTo WorkbookIsNotOpen
If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
WorkbookIsOpen = True
Exit Function
End If
WorkbookIsNotOpen:
End Function[/vba][vba]Option Explicit
 
Sub CopyAndPrint()
Dim Wb As Workbook
Dim WS As Worksheet
Dim ThisBook
Dim i As Long
If WorkbookIsOpen("Veroinsiirto.xls") Then
Workbooks("Ast_07.xls").Activate
Else
Application.Workbooks.Open _
(ActiveWorkbook.Path & "\Veroinsiirto.xls")
Workbooks("Ast_07.xls").Activate
ActiveWorkbook.Sheets("Sheet1").Activate
DoEvents
End If
Set Wb = Workbooks("Veroinsiirto.xls")
Set WS = Wb.Sheets("Taul2")
Set ThisBook = ActiveWorkbook.Sheei = 2
Do
ThisBook.Range("A" & i).Select
'DESTINATION SOURCE
WS.Range("A6") = ThisBook.Range("A" & i)
WS.Range("J6") = ThisBook.Range("B" & i)
WS.Range("A16") = ThisBook.Range("Z" & i)
WS.Range("M16") = ThisBook.Range("AA" & i)
WS.Range("H8") = ThisBook.Range("AO" & i)
WS.Range("D10") = ThisBook.Range("AO" & i)
WS.Range("D36") = ThisBook.Range("AV" & i)
WS.Range("J16") = ThisBook.Range("AZ" & i)
WS.Range("A2") = ThisBook.Range("BB" & i)
WS.Range("J2") = ThisBook.Range("BB" & i)
WS.Range("A23") = ThisBook.Range("BD" & i)
WS.Range("J23") = ThisBook.Range("BE" & i)
WS.Range("M23") = ThisBook.Range("BF" & i)
WS.PrintOut copies:=6
ActiveCell.Rows.EntireRow.ClearContents
ActiveCell.Offset(1, 0).Select
i = i + 1
Loop Until ActiveCell = Empty
Wb.Close SaveChanges:=False
Set WS = Nothing
Set Wb = Nothing
Set ThisBook = Nothing
End Sub

---