Search & insert

[Ticotion]

Hi

I'm new to programming in Excel and have some problems.

I have an excel sheet in workbook1 where in cell A1 I have a name eg. Jhon
Jonsson.

In cell c4 I have an estimated workload eg. 75% and in cell C5 real workload
eg. 100%. In cell F2 I have a week number eg. 50.

I want excel to search for the name in coloumn A range 16 to 35 in another
excel workbook2. After that is has to find the week number in row 15. If it
finds a match it should input the estimated workload from workbook1 into the
corrisponding field in workbook2 and the real workload in the corrisponding
field. The layout of workbook2 is like this:

Est. Workload Actual workload Est. Workload
Actual workload
Week 1
2
John Johnson
name2
name3
etc.

Could you help?

Br
Ticotion

 

[joel]

Modify as required


Sub MoveData()

Set sourcesht = Workbooks("Book1.xls").Sheets("Sheet1")
Set DestSht = Workbooks("Book2.xls").Sheets("Sheet1")

With sourcesht
Person = .Range("A1")
EstWorkLoad = .Range("C4")
RealWorkLoad = .Range("C5")
WeekNum = .Range("F2")

End With

With DestSht
Set c = .Range("A16:A35").Find(what:=Person, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Set c1 = .Rows(15).Find(what:=WeekNum, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c1 Is Nothing Then
..Cells(c.Row, c1.Column) = EstWorkLoad
End If
End If
End With
End Sub

 

[Ticotion]

Hi Joel

This almost works as I want. One thing is though that in row 13 in the
destsht the code has to find the Estworkload or the realworkload, then have
to find the weekno, and then insert the value that corrisponds to to row13
headlines. How whould this be done?

Br.
Ticotion

 

[Ticotion]

Hi

I found the solution. Very simple just added

..Cells(c.Row, c1.Column) = EstWorkLoad
to the code

Would it be possible to write to a closed excel workbook? An how could this
be done in the code?

Thank you for your help

Ticotion

Hi Joel

This almost works as I want. One thing is though that in row 13 in the
destsht the code has to find the Estworkload or the realworkload, then have
to find the weekno, and then insert the value that corrisponds to to row13
headlines. How whould this be done?

Br.
Ticotion

Modify as required


Sub MoveData()

Set sourcesht = Workbooks("Book1.xls").Sheets("Sheet1")
Set DestSht = Workbooks("Book2.xls").Sheets("Sheet1")

With sourcesht
Person = .Range("A1")
EstWorkLoad = .Range("C4")
RealWorkLoad = .Range("C5")
WeekNum = .Range("F2")

End With

With DestSht
Set c = .Range("A16:A35").Find(what:=Person, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Set c1 = .Rows(15).Find(what:=WeekNum, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c1 Is Nothing Then
.Cells(c.Row, c1.Column) = EstWorkLoad
End If
End If
End With
End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=163315

Microsoft Office Help

.

 

[joel]

I'm not sure if I got it exactly right but these changes should help.
may of not understood what the data in rows 13 and 15 look like.
added to one of the Find methods the after property so you can look fo
the week number after a certain column.

Sub MoveData()

Set sourcesht = Workbooks("Book1.xls").Sheets("Sheet1")
Set DestSht = Workbooks("Book2.xls").Sheets("Sheet1")

With sourcesht
Person = .Range("A1")
Estworkload = .Range("C4")
Realworkload = .Range("C5")
WeekNum = .Range("F2")

End With

With DestSht
Set c = .Range("A16:A35").Find(what:=Person, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Set StartCol = .Rows(13).Find(what:="Estworkload", _
LookIn:=xlValues, lookat:=xlWhole)
If StartCol Is Nothing Then
MsgBox ("Cannot find : ESTworkload")
Else
Set c1 = .Rows(15).Find(what:=WeekNum, _
after:=.Cells(15, StartCol.Column - 1), _
LookIn:=xlValues, _
lookat:=xlWhole)

If Not c2 Is Nothing Then
.Cells(c.Row, c2.Column) = Estworkload
End If
End If
Set StartCol = .Rows(13).Find(what:="realworkload", _
LookIn:=xlValues, lookat:=xlWhole)
If StartCol Is Nothing Then
MsgBox ("Cannot find : ESTworkload")
Else
Set c1 = .Rows(15).Find(what:=WeekNum, _
after:=.Cells(15, StartCol.Column - 1), _
LookIn:=xlValues, _
lookat:=xlWhole)

If Not c2 Is Nothing Then
.Cells(c.Row, c2.Column) = Realworkload
End If
End If
End If
End With
End Su

 

[Ticotion]

Hi Joel

Thank you for your help. Is is possible to update the DestSht (destination
excel file) if it is closed? How can this be done?

I use the following code which is your original code modified slightly:

Function MoveData()

Set sourcesht = Workbooks("SIM overview TEST.xls").Sheets("Sheet1")
Set DestSht = Workbooks("Activity overview1.xls").Sheets("Sheet1")

With sourcesht
Person = .Range("A1")
Estworkload = .Range("C4")
Realworkload = .Range("C5")
WeekNum = .Range("F2")
End With

With DestSht
Set c = .Range("A15:A34").Find(what:=Person, _
LookIn:=xlValues, lookat:=xlWhole)

If Not c Is Nothing Then

Set c1 = .Rows(14).Find(what:=WeekNum, _
LookIn:=xlValues, lookat:=xlWhole)

If Not c1 Is Nothing Then
..Cells(c.Row, c1.Column) = Estworkload
..Cells(c.Row, c1.Column + 1) = Realworkload

End If
End If
End With


End Function

Thank you

Ticotion

 

[joel]

to write to an excel file when it is closed you use theh ADO method.
All microsoft office prodcuts have the same file structure whic
consitst of sheets (or table in access which are the same), documents
slides, charts, pictures, ..., etc. the only real difference between a
excel xls file and an access mdb file is the file extension. So you ca
read and write an xls file exactly like you would an access mdb file.

I have written to databases using ADO before but the syntax i
extremely sensitive and can take me hour to get on estatement correct.
This was the first time I tried using an excel workbook and it took m
literaly the whole day.

the SQL statement to open the work sheet required a dollar sign at th
end of the sheet name and required the sheet name to be in squar
brackets. Some examples I had backward single quote which didn't work.
I tried all combinations of nobrackets, brackets, dollar signs, forwar
single quotes, and backards single quotes before I got it to work. Th
syntac isn't the same whan you work with a mdb file and an xls file.

Another problem I had was cuasd by the way your worksheet is organized
Usually, ADO method is easier because the 1st row of the worksheet i
the names of the columns when working with databases. Since I didn'
know the names of the colunms (row 1 data) I had to use the colum
Number to get the data which using ADO if the Fields.

The next problem I have is the code didn't work unless I had data i
Cell A1. I then put numbers in colunm A to help me diagnosis why th
code wasn't working. Doing this I never found Joel in cell A26. Whe
using ADO method you can't just specify go to row 14. Instead you hav
to move the recordset forward 13 times from row 1. I put numbers i
column A from 1 to 25 and put my name Joel in Row 26. I reached the En
of file before I got to row 26. I think the code thought the format o
column A was number and didn't like that a string was also in th
column.

I then had to use an SQL statement to find "Joel" in column A. Thi
took hours to get the sytac correct. Finally I got the correct row an
columns, but the data never got saved. I had the wrong parameters i
the Recordset Open statement and the file was in a read only mode.

Warning, This code may not work with your data. I added some messag
boxes to help you isolate any problems.


Sub MoveData()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Set sourcesht = ThisWorkbook.Sheets("Sheet1")
Folder = "c:\Temp\"
DestFile = Folder & "Activity overview1.xls"
'excel worksheet must have dollar sign at end of name
DestShtName = "Sheet1" & "$"

With sourcesht
Person = .Range("A1")
EstWorkLoad = .Range("C4")
RealWorkLoad = .Range("C5")
WeekNum = .Range("F2")
End With

'open a connection, doesn't open the file
Set cn = New ADODB.Connection

With cn

ConnectStr = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & DestFile & ";" & _
"Mode=Share Deny None;" & _
"Extended Properties=""Excel 8.0;HDR=No;ReadOnly=False;"""

.Open (ConnectStr)
End With

'open the recordset
Set rs = New ADODB.Recordset
With rs

MySQL = "SELECT * FROM [" & DestShtName & "] "

.Open Source:=MySQL, _
ActiveConnection:=cn

If .EOF <> True Then

RowCount = 1
Do While Not .EOF And RowCount < 14

.MoveNext
RowCount = RowCount + 1
Loop

If .EOF Then
MsgBox ("Not Enough Rows - Exit macro")
End If

setLoad = ""

WorkWeekCol = 0
WorkWeek = 22
For Each Fld In rs.Fields
If Fld.Value = WorkWeek Then
'rows and columns are backwards from excel
WorkWeekCol = Range(Fld.Name).Row
Exit For
End If
Next Fld
End If

If WorkWeekCol = 0 Then
MsgBox ("Did not find WorkWeek : " & WorkWeek & ". Exitin
Macro")
Exit Sub
End If

.Close

Person = "Joel"

MySQL = "SELECT *" & vbCrLf & _
"FROM [" & DestShtName & "] " & vbCrLf & _
"Where [" & DestShtName & ".F1]='" & Person & "'"

.Open Source:=MySQL, _
ActiveConnection:=cn, _
LockType:=adLockOptimistic, _
CursorType:=adCmdTable



If .EOF = True Then
MsgBox ("count not find : " & Person & " Exit Macro")
Exit Sub
Else

EstWorkLoad = 123
RealWorkLoad = 456
'field start at zero, subtract one from index
.Fields(WorkWeekCol - 1).Value = EstWorkLoad
.Fields(WorkWeekCol).Value = RealWorkLoad
.Update
End If


End With

rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

End Sub