Board index » Excel » Macro

Excel128
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!


-

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



In article <d2gm4d$4j4$1@ss405.t-com.hr>, davor_zupanic@yahoo.com

says...

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



-