Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here


Add value to cell instead of replace

Add value to cell instead of replace

Add value to cell instead of replace

Hello people,

The code does following:

Loop through all Cells for every row in the Master file.
for each cell open a Separate file Loop through all used cells in column in "H", If the cells are equal take the Cell same row Column "i"; paste it in the Master file to the same row as the first number but column "i" also color the row red.
From the seperate file If the IO number doesn't exists in the master file, add the IO numbercolumn in "H" + the number besides same row column in "I" to the last unused row in the Master file also color add color yellow.

Now I need to do a little change.

Instead of replace the number in master file in column [i] I want the macro to add to the current value the current cell if there is any number instead of replace.

so example:
master file:

Separate file:

this is my current result:

How I want the result:

Here is my Code:


Sub Use1Work()

    Dim MastShRnG As Range
    Dim SlavRng As Range
    Dim SlaveWb As Workbook
    Dim SlaveWs As Worksheet
    Dim FileName As String
    Dim FolderPath As String
    Set MasWb = ActiveWorkbook
    Set MasWbs = Worksheets(1)
    x = MasWbs.Range("H" & Rows.Count).End(xlUp).Row

    Set MastShRnG = MasWbs.Range("H1:H" & x)
    FolderPath = "C:\DATA\"
    File = Dir(FolderPath)
        While (File <> "")
                Set SlaveWb = Workbooks.Open(FolderPath & File)
                Set SlaveWs = SlaveWb.Worksheets(1)
                y = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
                Set SlavRng = SlaveWs.Range("H1:H" & y)
                For Each cell In SlavRng
                            If IsNumeric(cell.Offset(0, 1)) And cell.Value <> "" Then
                                res = Application.Match(cell, MastShRnG, 0)
                                        If Not IsError(res) Then
                                            MasWbs.Cells(res, "I") = cell.Offset(0, 1)
                                            MasWbs.Cells(res, "I").Interior.ColorIndex = 3
                                            x = x + 1
                                            MasWbs.Cells(x, "H") = cell
                                            MasWbs.Cells(x, "I") = cell.Offset(0, 1)
                                            MasWbs.Cells(x, "I").Interior.ColorIndex = 6
                End If
                            End If
                Next cell
              ' MsgBox MasWbs.Cells(x, "H").Value
                Workbooks(File).Close SaveChanges:=False
                File = Dir
End Sub 

Could someone help me thank you in advance?
Best regards

RE: Add value to cell instead of replace

Instead of assigning value add it:
MasWbs.Cells(res, "I") = MasWbs.Cells(res, "I")+cell.Offset(0, 1).
There is a non-acces vba forum: http://www.tek-tips.com/threadminder.cfm?pid=707


RE: Add value to cell instead of replace

> forum707: VBA Visual Basic for Applications (Microsoft): VBA Visual Basic for Applications (Microsoft) which is restricted to MS Access coding.

Er ... are you sure? Did you perhaps mean that it isn't restricted to MS Access coding, which this forum is

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close