Simplify Code help

[DavidH56]

Hi,

Is there a way to simplyfy this code? I'm basically updating the Master
sheet in 5 adjacent columns.

Sub LookupUpdateExisting()
Dim Cel As Range, c As Range
With Sheets("Master")
For Each Cel In Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set c = Sheets("Update").Columns(1).Find(Cel, lookat:=xlWhole)
If Not c Is Nothing Then
Cel.Offset(, 1) = c.Offset(, 1)
End If
Next
End With
With Sheets("Master")
For Each Cel In Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set c = Sheets("Update").Columns(1).Find(Cel, lookat:=xlWhole)
If Not c Is Nothing Then
Cel.Offset(, 2) = c.Offset(, 2)
End If
Next
End With
With Sheets("Master")
For Each Cel In Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set c = Sheets("Update").Columns(1).Find(Cel, lookat:=xlWhole)
If Not c Is Nothing Then
Cel.Offset(, 3) = c.Offset(, 3)
End If
Next
End With
With Sheets("Master")
For Each Cel In Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set c = Sheets("Update").Columns(1).Find(Cel, lookat:=xlWhole)
If Not c Is Nothing Then
Cel.Offset(, 4) = c.Offset(, 4)
End If
Next
End With
With Sheets("Master")
For Each Cel In Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set c = Sheets("Update").Columns(1).Find(Cel, lookat:=xlWhole)
If Not c Is Nothing Then
Cel.Offset(, 5) = c.Offset(, 5)
End If
Next
End With
End Sub

Thanks in advance.

 

[Mike H]

Hi,

not tested but this should do it,

Sub LookupUpdateExisting()
Dim Cel As Range, c As Range
For x = 1 To 5
With Sheets("Master")
For Each Cel In Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set c = Sheets("Update").Columns(1).Find(Cel, lookat:=xlWhole)
If Not c Is Nothing Then
Cel.Offset(, x) = c.Offset(, x)
End If
Next
End With
Next
End Sub

Mike

 

[JP]

This is air code so test first.

Sub LookupUpdateExisting()
Dim Cel As Range, c As Range
Dim i As Long
Do Until i = 5
With Sheets("Master")
For Each Cel In Range(.Cells(2, 1), .Cells(.Rows.Count,
1).End(xlUp))
Set c = Sheets("Update").Columns(1).Find(Cel,
lookat:=xlWhole)
If Not c Is Nothing Then
Cel.Offset(, i) = c.Offset(, i)
End If
i = i + 1
Next
End With
Loop
End Sub

--JP

 

[Jim Thomlinson]

Sub LookupUpdateExisting()
Dim Cel As Range, c As Range
With Sheets("Master")
For Each Cel In Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set c = Sheets("Update").Columns(1).Find(Cel, lookat:=xlWhole)
If Not c Is Nothing Then
Cel.Offset(0, 1).resize(1,4).value = c.Offset(0,
1).resize(1,4).value
End If
Next
End With
end sub

 

[Jim Thomlinson]

Ooops... In the resize of the range change the 4 to a 5...

 

[Rick Rothstein]

You forget a dot in front of the Range function on the For Each line.

Also untested... I think this slight simplification will do the same as your
code (it eliminates a loop)...

Sub LookupUpdateExisting()
Dim Cel As Range, c As Range
With Sheets("Master")
For Each Cel In .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set c = Sheets("Update").Columns(1).Find(Cel, lookat:=xlWhole)
If Not c Is Nothing Then
c.Offset(, 1).Resize(1, 5).Copy Cel.Offset(, X)
End If
Next
End With
End Sub

 

[Mike H]

hi,

You would need to initialise i (i=1) so it isn't zero on the first pass and
increment i outside the with - end with statement

Mike

This is air code so test first.

Sub LookupUpdateExisting()
Dim Cel As Range, c As Range
Dim i As Long
Do Until i = 5
With Sheets("Master")
For Each Cel In Range(.Cells(2, 1), .Cells(.Rows.Count,
1).End(xlUp))
Set c = Sheets("Update").Columns(1).Find(Cel,
lookat:=xlWhole)
If Not c Is Nothing Then
Cel.Offset(, i) = c.Offset(, i)
End If
i = i + 1
Next
End With
Loop
End Sub

--JP

 

[JP]

Thanks, knew I'd forgotten something.

--JP

hi,

You would need to initialise i (i=1) so it isn't zero on the first passand
increment i outside the with - end with statement

Mike






- Show quoted text -

 

[DavidH56]

Thanks for your quick response Jim. Thanks Rick and Mike and JP for your
input.
This works perfectly and so fast. I'm always amazed at the vast knowledge
that I glean from you experts. This is exactly what I was looking for. One
last question. How would I copy over formats as well? (ie bold font..)

Thanks again.

 

[Rick Rothstein]

Thanks for your quick response Jim. Thanks Rick and Mike and JP for your

input.
This works perfectly and so fast. I'm always amazed at the vast knowledge
that I glean from you experts. This is exactly what I was looking for. One
last question. How would I copy over formats as well? (ie bold font..)

I guess you didn't actually try my code out then, did you?<g>

The code I posted preserve the formatting of the cell.

 

[DavidH56]

Yes I did try your code at home. Not at work. The code worked but for some
reason format was not maintained. I'll try at work tomorrow.

Thanks..

 

[DavidH56]

My mistake Rick, I tried Jim's code. I hadn't realized they're different.

 

[DavidH56]

Rick, I just tried you code. Font formatting was maintained bur I lost column
and row formatting on the master sheet.

Thanks.

 

[Rick Rothstein]

When you say "I lost column and row formatting on the master sheet", I
presume you mean in the cells on the master sheet that were copied to... not
the entire column of formatted cells. Yes, the Copy method changes the
cell(s) it copies to's formatting to that of the cell(s) it copied from.
What surprises me about your statement is that you have the cells on one
sheet formatted differently than the cells on the other sheet **for the
exact same data**. Have I interpreted your comment correctly? Out of
curiosity, what is the formatting on each sheet that you are actually using?

 

[DavidH56]

On both sheets columns a through f have widths of 9.57, 80.71, 5.86, 5.43,
11.71 and 8.43 respectively. Both sheets also have size 8 tahoma fonts. Row
a is the header row. Sometimes I get bold fonts on update sheets. Both
sheets initially have as headers ID, Title, Stat, Code, ICN and ICN Chg Cd. I
just ran your code again and what actually happened was on the master sheet
the IDs (data) where removed and Title data shifted to column a instead of
column b. The others shifted to the left as well and ICN Chg cd data were in
both columns e and f. The column widths were resized as well.

Thanks again for your response.


Thanks again for your response