Macro

[DZ]

How to make a macro who will, depending on code and values in sheet1
decrease value of same code in sheet2 and copy value of cell d1,

Sheet1:
A B C D
1 M009/05
2 1234 5
3 2345 1
4 5678 2

(Note: value of cell D1 is 9 but format is "M"000"/05" - p.s. number is
increasing automatic, that is ok)

--------------------------------------------------

Sheet2 (Before):
A B C D E
2 1234 100 M001/05; M002/05 (Existing values)
3 2345 100 M006/05
4 5678 100

Sheet2 (After):
A B C D E
2 1234 95 M001/05; M002/05; M009/05
3 2345 99 M006/05; M009/05
4 5678 98 M009/05


Help!

 

[Tushar Mehta]

Lightly tested:

Option Explicit

Sub updateMaster()
Dim aCell As Range, FoundCell As Range, SourceRng As Range
With Sheets("sheet1")
Set SourceRng = _
Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each aCell In SourceRng
Set FoundCell = Nothing
Set FoundCell = Sheets("sheet2").Columns("a").Find(aCell.Value)
If FoundCell Is Nothing Then
MsgBox "Sheet2 does not have an entry for " & aCell.Value
Else
FoundCell.Offset(0, 1).Value = _
FoundCell.Offset(0, 1).Value - aCell.Offset(0, 1).Value
With FoundCell.Offset(0, 3)
If .Text <> "" Then .Value = .Text & ";"
.Value = .Text & aCell.Parent.Range("D1").Text
End With
End If
Next aCell
End Sub




--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[Seiya]

try

Sub test()
Dim r As Range, SearchStr As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("sheet1"): Set ws2 = Sheets("sheet2")
For Each r In ws1.Range("a1", ws1.Range("a65536").End(xlUp))
Set SearchStr = ws2.Columns(1).Find(what:=r.Value)
If Not SearchStr Is Nothing Then
With SearchStr
.Offset(, 2) = .Offset(, 2) - r.Offset(, 2)
With .Offset(, 4)
If IsEmpty(.Value) Then
.Value = ws1.Range("d1").Text
Else
.Value = .Value & "; " & ws1.Range("d1").Text
End If
End With
End With
End If
Next