Find copy data from a cell in Personal workbook and copy it to a cellin current workbook

[ezduzitez]

To all,

I had this working at one time, but messed it up somehow . I would like to find specific data from the Personal workbook and paste it to a cell in the current workbook. This data changes all the time so I keep adding as new "Surface Roughness" values come along. Your help is greatly appreciated.

==============================================

Sub SURFACEROUGHNESS()

'SURFACE ROUGHNESS

Cells.Find(What:="Surface Roughness: <= 4 uin", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.ClearContents
Windows("PERSONAL.XLSB").Activate
Range("B4").Select
Selection.Copy
Windows("test.xls").Activate
ActiveSheet.Paste

Cells.Find(What:="Surface Roughness: <= 6 uin", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.ClearContents
Windows("PERSONAL.XLSB").Activate
Range("B6").Select
Selection.Copy
Windows("test.xls").Activate
ActiveSheet.Paste

Cells.Find(What:="Surface Roughness: <= 20 uin", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.ClearContents
Windows("PERSONAL.XLSB").Activate
Range("B20").Select
Selection.Copy
Windows("test.xls").Activate
ActiveSheet.Paste

End Sub
==========================================

 

[Claus Busch]

Hi,

Am Thu, 20 Jun 2013 09:08:42 -0700 (PDT) schrieb (e-mail address removed):

Sub SURFACEROUGHNESS()

'SURFACE ROUGHNESS

Cells.Find(What:="Surface Roughness: <= 4 uin", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.ClearContents
Windows("PERSONAL.XLSB").Activate
Range("B4").Select
Selection.Copy
Windows("test.xls").Activate
ActiveSheet.Paste

you don't need Select, Selection and Activate if you refer correctly.
Try (Modify ranges and sheet names to suit):

Sub Test()
Dim c As Range
Dim i As Integer

i = 1
With Workbooks("PERSONAL.xlsb").Sheets("Sheet1")
Set c = .Cells.Find("Surface Roughness: <= 4 uin", _
LookIn:=xlFormulas, lookat:=xlPart)
If Not c Is Nothing Then
ActiveWorkbook.Sheets("Sheet1").Cells(i, 1) = c
i = i + 1
End If
Set c = .Cells.Find("Surface Roughness: <= 6 uin", _
LookIn:=xlFormulas, lookat:=xlPart)
If Not c Is Nothing Then
ActiveWorkbook.Sheets("Sheet1").Cells(i, 1) = c
i = i + 1
End If
Set c = .Cells.Find("Surface Roughness: <= 20 uin", _
LookIn:=xlFormulas, lookat:=xlPart)
If Not c Is Nothing Then
ActiveWorkbook.Sheets("Sheet1").Cells(i, 1) = c
End If
End With
End Sub



Regards
Claus Busch

 

[Claus Busch]

Hi again,

Am Thu, 20 Jun 2013 18:28:54 +0200 schrieb Claus Busch:

With Workbooks("PERSONAL.xlsb").Sheets("Sheet1")
Set c = .Cells.Find("Surface Roughness: <= 4 uin", _
LookIn:=xlFormulas, lookat:=xlPart)

if Surface Roughness... is in column A and you will copy the adjacent
cell in column B then try:

Sub Test()
Dim c As Range
Dim i As Integer
Dim LRow As Long

i = 1
With Workbooks("PERSONAL.xlsb").Sheets("Sheet1")
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set c = .Range("A1:A" & LRow).Find("Surface Roughness: <= 4 uin", _
LookIn:=xlFormulas, lookat:=xlPart).Offset(0, 1)
If Not c Is Nothing Then
ActiveWorkbook.Sheets("Sheet1").Cells(i, 1) = c
i = i + 1
End If
Set c = .Range("A1:A" & LRow).Find("Surface Roughness: <= 6 uin", _
LookIn:=xlFormulas, lookat:=xlPart).Offset(0, 1)
If Not c Is Nothing Then
ActiveWorkbook.Sheets("Sheet1").Cells(i, 1) = c
i = i + 1
End If
Set c = .Range("A1:A" & LRow).Find("Surface Roughness: <= 20 uin", _
LookIn:=xlFormulas, lookat:=xlPart).Offset(0, 1)
If Not c Is Nothing Then
ActiveWorkbook.Sheets("Sheet1").Cells(i, 1) = c
End If
End With
End Sub


Regards
Claus Busch

 

[ezduzitez]

Hello again Claus,

It seems to be exactly what I need, but I failed to give specifics again (I'll get it right eventually).

=The data I need to copy is located on PERSONAL.xlsb on Sheet1. It's on Column B only and goes down from there (1 thru 100) depending on the surface finish needed.

=The data that needs to be found and replaced is on the D-column starting at D5 of the ActiveWorkbook (name varies all the time)

Example = I need to find "Surface Roughness: <= 6 uin" within the Form 3 of the ActiveWorkbook, then go to "Personal.xlsb" and copy the corresponding custom symble from cell B6 and so on. There are usually more than one and they are usually different.

Surface number matches cell number from 1 to 100. Surface 100 = B100

Thanks so much Claus

 

[Claus Busch]

Hi,

Am Thu, 20 Jun 2013 12:05:57 -0700 (PDT) schrieb (e-mail address removed):

=The data I need to copy is located on PERSONAL.xlsb on Sheet1. It's on Column B only and goes down from there (1 thru 100) depending on the surface finish needed.

=The data that needs to be found and replaced is on the D-column starting at D5 of the ActiveWorkbook (name varies all the time)

Example = I need to find "Surface Roughness: <= 6 uin" within the Form 3 of the ActiveWorkbook, then go to "Personal.xlsb" and copy the corresponding custom symble from cell B6 and so on. There are usually more than one and they are usually different.

Surface number matches cell number from 1 to 100. Surface 100 = B100

do you want to replace the searched value with the symbol or do you want
to paste the symbol in the adjacent cell? To cell E?
Do you want to find all symbols for the values in column D?


Regards
Claus Busch

 

[Claus Busch]

Hi,

Am Thu, 20 Jun 2013 12:05:57 -0700 (PDT) schrieb (e-mail address removed):

=The data I need to copy is located on PERSONAL.xlsb on Sheet1. It's on Column B only and goes down from there (1 thru 100) depending on the surface finish needed.

=The data that needs to be found and replaced is on the D-column starting at D5 of the ActiveWorkbook (name varies all the time)

Example = I need to find "Surface Roughness: <= 6 uin" within the Form 3 of the ActiveWorkbook, then go to "Personal.xlsb" and copy the corresponding custom symble from cell B6 and so on. There are usually more than one and they are usually different.

Surface number matches cell number from 1 to 100. Surface 100 = B100

you didn't answer and I have to go to bed. Therefore I uploaded the
workbook "Find" to SkyDrive:
https://skydrive.live.com/#cid=9378AAB6121822A3&id=9378AAB6121822A3!326
Macro Test searches all cells in D and copy the symbol from
"PERSONAL.xlsb" in same row in column E
Macro Test2 only searches the 3 values and also copies the symbol to
column E.
Till Tomorrow.


Regards
Claus Busch

 

[Claus Busch]

Hi,

Am Thu, 20 Jun 2013 22:07:47 +0200 schrieb Claus Busch:

you didn't answer and I have to go to bed. Therefore I uploaded the
workbook "Find" to SkyDrive:

in SkyDrive macros are disabled. Rightclick on the workbook and download
it.


Regards
Claus Busch

 

[ezduzitez]

Hello again Claus,

I really appreciate your support in the past. I was pulled from finishing this work and now I'm back at it finally. I had a hard time finding my way to this Group. There's so many of them.

In the past I was not able to load reference files and now that I came back to this group and to your "SkyDrive" it's not there since it's been a long time.

I loaded reference files at this other group and no one has been able to help. I'm glad I finally found this group again. You guys helped me lots in the past

https://groups.google.com/d/msg/excel-macros/SucwuFOhSAY/rojFxyN8A7sJ

 

[Claus Busch]

Hi,

Am Thu, 30 Jan 2014 10:02:51 -0800 (PST) schrieb (e-mail address removed):

I really appreciate your support in the past. I was pulled from finishing this work and now I'm back at it finally. I had a hard time finding my way to this Group. There's so many of them.

In the past I was not able to load reference files and now that I came back to this group and to your "SkyDrive" it's not there since it's been a long time.

I heard nothing from you for a long time so I thought you were through
with this work and I deleted the workbook.
Please have a look here:
https://skydrive.live.com/#cid=9378AAB6121822A3&id=9378AAB6121822A3!326
for the workbook "Find".
If you need more help please specify your problems.


Regards
Claus B.

 

[Ez Duzit]

I see the files in "Skydrive" but my company's firewall blocks access to the "live.com" so I can't log in to download the file :-(

 

[Claus Busch]

Hi,

Am Fri, 31 Jan 2014 09:14:05 -0800 (PST) schrieb Ez Duzit:

I see the files in "Skydrive" but my company's firewall blocks access to the "live.com" so I can't log in to download the file :-(

you don't have to log in. Right click and download or Right click =>
open in Excel.


Regards
Claus B.

 

[Ez Duzit]

Hello again,

It did work, but I had some problems as it searched for different surfaces and I couldn't figure out how to solve it. I changed the file names and sheet names to match my latest files. I managed to place the latest sample files online. http://dropcanvas.com/o16ya

Your help is greatly appreciated.

 

[Claus Busch]

Hi,

Am Wed, 5 Feb 2014 14:25:51 -0800 (PST) schrieb Ez Duzit:

It did work, but I had some problems as it searched for different surfaces and I couldn't figure out how to solve it. I changed the file names and sheet names to match my latest files. I managed to place the latest sample files online. http://dropcanvas.com/o16ya

I put the symbol sheet into workbook "Surface Finish End Result File"
Open "Surface Finish Start File" and "Surface Finish End Result File".
Activate "Surface Finish End Result File" and the sheet AS9102=Form 3
and run the macro "Symbols". To delete all symbols activate the sheet
and run "DelAllIcons"
Have a look:
https://skydrive.live.com/#cid=9378AAB6121822A3&id=9378AAB6121822A3!326
and right click and download both files because macros are disabled in
SkyDrive.


Regards
Claus B.

 

[Ez Duzit]

Hello Claus,

I was able to download the excel files, but the macros don't download for some reason and I tried several times now. Could you please do me a favor and replace the files in the "dropcanvas" link. http://dropcanvas.com/o16ya

Thanks again!

 

[Claus Busch]

Hi,

Am Thu, 6 Feb 2014 09:20:25 -0800 (PST) schrieb Ez Duzit:

I was able to download the excel files, but the macros don't download for some reason and I tried several times now. Could you please do me a favor and replace the files in the "dropcanvas" link. http://dropcanvas.com/o16ya

please look here:
http://dropcanvas.com/lau2k


Regards
Claus B.