Complicated Procedure? Maybe Not.

[Vamphyri]

Good afternoon, all!

I have been searching for a way (or even a hint of) a way to do the following in a workbook I open with a GetOpenFilename macro:
1) Search for a certain string (ie. "Date of Birth")
2) Copy the values from the "Date of Birth" column into my original workbook (the one that contains the GetOpenFilename coding).

Just to complicate matters there have been several iterations of the workbooks I need to open. Added to that is the fact that the "Date of Birth" column will not always be in the same spot on every workbook. It may start in [C4] in one workbook and start on [F9] in another. Their lengths will also be different.

Trying the macro recorder gives me an idea of what i am trying to accomplish, but I am having a hard time figuring out how to have the code move to the cell directly below the cell that contains "Date of Birth". The code simply selects a specific cell in the macro recorder.

Any hints or tips will be appreciated.

Here's the code thus far:

[CODE

Sub TryThis2()

Cells.Find(What:="Birth", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Range("E14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.ActivateNext
Range("C5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "mm/dd/yy"
Range("C4").Select
End Sub

CODE]


Thanks



In the immortal words of Socrates, who said:
"I drank what?

 

[SkipVought]

The correct way to post code is
[ignore]

[/ignore]
[code]
your code here

[ignore]
[/code]
[/ignore]


Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[SkipVought]

Check out faq68-5829.

It is a start. You can use the query to grab the data in an QUERY sheet, and then copy to the appropriate place in your other sheet.

You will need to macro record EDITING the query once the querytable has been added to your sheet. Post back with the recorded code to customize with multiple workbook sources.

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[Vamphyri]

Skip,

My fault. I should have indicated that there are rows of information above the required data in the "Source" workbook. Bad form, I know. However, this is what I have to work with.

I tried using MS Query, but it would not find the information I was needing to query on.

Any other suggestions would be appreciated.

I will try playing with MS Query for a bit to see if I can cajole it into cooperating.

Thanks



In the immortal words of Socrates, who said:
"I drank what?

 

[SkipVought]

You shoot your self in the foot when you do not have data stored in a proper format, like a table that is totally separate from any reporting format that you might need.

Now, you must perform heroic daring deeds of epoch preportions, in order to acquire the data. There is an easier way.

Well, using the present setup, is the table ISOLATED from any data ABOVE, BELOW, to the LEFT or RIGHT. Ie is you use the CurrentRegion Icon from the Edit Toolbar, does it only select this table and not any other data?

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[Vamphyri]

Skip,

Yes, the CurrentRegion only selects the datatable I need to perform the find / copy / paste actions on.

May I assume this is a "good" thing?

What do you have in mind?




In the immortal words of Socrates, who said:
"I drank what?

 

[SkipVought]

NOTE: I have use TWO bogus Sheet Objects: SomeSheetObject, & ORIGINALSheetObject, your target sheet...

Sub TryThis2()
    With SomeSheetObject
        .Cells.Find(What:="Birth", After:=.[A1], LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False).CurrentRegion.Copy
    End With
'    ActiveWindow.ActivateNext  '''not a recommended method
    With ORIGINALSheetObject
        .Cells(5, "C").End(xlDown).Offset(1).Select
        .PasteSpecial xlValues
        .Columns(3).NumberFormat = "mm/dd/yy"
    End With
End Sub

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[Vamphyri]

Skip,

First, I have been remiss in welcoming you back to the community. Hope everything went well and recovery was smooth and painless.

On to the important stuff...me and my problems. LOL

What code would you recommend for switching between 2, or more, workbooks since you stated:

'    ActiveWindow.ActivateNext  '''not a recommended method

is not recommended?

I have checked in the VBA help files and they recommend using the Worksheets("Sheet1").Activate method. I know you, usually, recommend against using th e"activate" and "select" methods.

Any suggestions?

The reason I ask is the code fails on line:

With ORIGINALSheetObject

I have, of course, replaced the SheetObject with the name of my sheet name ("Old").

I appreciate the help. Honestly.

Chris


In the immortal words of Socrates, who said:
"I drank what?

 

[SkipVought]

The ThisWorkbook object refres to the workbook that the macro is running in.

When you open a new workbook, assign to a workbook object like...

dim wbNew as workbook
'.....
set wsnew = workbooks.open.......

Do you know what Worksheet in the new workbook, you want to access, maybe it is MANY sheets in the new workbook...

dim wbNew as workbook, ws as worksheet
'.....
set wbnew = workbooks.open{filespec)

for each ws in wbnew.worksheets
    With ws
        .Cells.Find(What:="Birth", After:=.[A1], LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False).CurrentRegion.Copy
    End With

    With Thisworkbook.Sheets("old")
        .Cells(5, "C").End(xlDown).Offset(1).Select
        .PasteSpecial xlValues
    End With    
next
Thisworkbook.Sheets("old").Columns(3).NumberFormat = "mm/dd/yy"

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[Vamphyri]

Skip,

Is it possible to use a named range instead of a cell reference in the following portion of code?

    With Thisworkbook.Sheets("old")
        .Cells(5, "C").End(xlDown).Offset(1).Select
        .PasteSpecial xlValues
    End With

I have tried looking this up as well, but continuously get an error.


In the immortal words of Socrates, who said:
"I drank what?

 

[SkipVought]

Sorry

    Thisworkbook.Sheets("old").Cells(5, "C").End(xlDown).Offset(1).PasteSpecial xlValues

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[Vamphyri]

Skip,

Thank you for the correction of code, however, I still do not know a named range (ie. "Date_of_Birth") instead of a cell reference.

Any ideas?

Thanks


In the immortal words of Socrates, who said:
"I drank what?

 

[Vamphyri]

Skip,

I got it!

Nevermind about the use of named ranges.

Thanks


In the immortal words of Socrates, who said:
"I drank what?

 

[Vamphyri]

Skip,

I have been beating my head against the proverbial wall trying to figure this out.

The following code is throwing "Run time error 1004: Activate method of range class failed":

Private Sub CommandButton1_Click()
    Dim Msg, Style, Title, Help, Ctxt, Response
        Msg = "Selecting YES will close and save any open excel workbooks and import a selected census.  Do you want to continue?"    ' Define message.
            Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define buttons.
            Title = "Continue?"    ' Define title.
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        If Response = vbYes Then ' User chose Yes.
            Application.ScreenUpdating = False
            CloseAllOthers
            OpenFile
            UnhideAndUnmergeAll
    'GetEmployerName
        Sheets("Census").Select
            Cells.Find(What:="Client Name", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False).Activate
        If ActiveCell.Offset(1, 0) = "" Then
            Exit Sub
        Else
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Copy
            ThisWorkbook.Sheets("Master").Range("Employer_Name").PasteSpecial Paste:=xlValues
        End If
            ActiveWindow.ActivateNext
    'GetEmployerAddress
        Sheets("Census").Select
            Cells.Find(What:="Address", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False).Activate
        If ActiveCell.Offset(1, 0) = "" Then
            Exit Sub
        Else
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Copy
            ThisWorkbook.Sheets("Master").Range("Employer_Address").PasteSpecial Paste:=xlValues
        End If

VBE highlights the following portion of code:

Cells.Find(What:="Client Name", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False).Activate

I have a hunch it is because I cannot figure out how to assign the newly opened workbook to a workbook object.

Any help or hints would be appreciated.

Thanks for your valuable time. Truly!


In the immortal words of Socrates, who said:
"I drank what?

 

[SkipVought]

A strongly advise against using Select, Activate, ActiveWHATEVER, unless it is the only method. It is the lazy-programmers worst friend.

Explicitly define every object, sheet, range etc.

You are flipping back and forth between sheet selects. This is not desirable.

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[Vamphyri]

Skip,

I know the flipping between sheets is NOT the best, nor the most efficient way, to accomplish what I am after.

I further agree that explicitly defining everything is a much cleaner code with fewer opportunities for errors.

However, I cannot figure out how to define a newly opened workbook and copy information from up to 13 different areas on the newly opened workbook into my spreadsheet without flipping and flopping about.

If there are any specific topics I can search on to read up on this or if you can offer some tips I would be most grateful.

Thanks a ton!


In the immortal words of Socrates, who said:
"I drank what?

 

[SkipVought]

}... I cannot figure out how to define a newly opened workbook ..."

dim wbNEW as workbook
set wbNEW = workbooks.open([i]filespec[/i])
'or
set wbNEW = workbooks.add
ThisWorkbook.Sheet1.usedrange.copy Destination:=wbnew.sheets(1).cells(wbnew.sheets(1).[A1].currentregion.rows.count+1,1)

ThisWorkbook.Sheet2.usedrange.copy Destination:=wbnew.sheets(1).cells(wbnew.sheets(1).[A1].currentregion.rows.count+1,1)

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[Vamphyri]

I think I'm on the right track here. The follwoing code is what I've come up with thus far.

Private Sub CommandButton1_Click()
    
    Dim wbNEW As Workbook
    Dim NewFileName As String
    Dim wb As Workbook
    Dim Msg, Style, Title, Help, Ctxt, Response
        Msg = "Selecting YES will close and save any open excel workbooks and import a selected census.  Do you want to continue?"    ' Define message.
            Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define buttons.
            Title = "Continue?"    ' Define title.
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then ' User chose Yes.
                    Application.ScreenUpdating = False
                    For Each wb In Application.Workbooks
                        If wb.Name <> "2008 Census (HB 2002) Conversion.xls" Then wb.Close
                        Next
                Do
                    NewFileName = Application.GetOpenFilename("Microsoft Excel Workbook (*.xls),*.xls")
                        If NewFileName = "False" Then
                            x = MsgBox("No file specified. Try again?", vbOKCancel)
                        If x = 2 Then Exit Sub
                        End If
                Loop While NewFileName = "False"
        Workbooks.Open (NewFileName)
    Set wbNEW = Workbooks.Open(NewFileName)
            Application.ScreenUpdating = True
        Else    ' User chose No.
            Exit Sub
    End If
End Sub

Obviously, this will prompt for a file to open with the msgBox. It will then prompt for a file to open with the line:

Set wbNEW = Workbooks.Open(NewFileName)

I would think there is a way to make a hybrid of the 2 to have the msgBox prmpt for the file and have "wbNEW" SET.

I have tried rearranging the order of the code, but to no avail.

What am I doing wrong? (Besides the obvious of being a VERY amateur "programmer" without much experience )



In the immortal words of Socrates, who said:
"I drank what?

 

[PHV]

[!]Rem[/!] Workbooks.Open (NewFileName)
Set wbNEW = Workbooks.Open(NewFileName)

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[SkipVought]

Here's the generalized approch.

Instead of an OPEN or FIND statement, you SET an object in the OPEN or FIND statement, and then use that object variable as a reference.

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}