Macro
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! |
Macro
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 , says... 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! |
Macro
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 |
All times are GMT +1. The time now is 07:03 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com