Instead of replace a number add.

[elmnas]

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 want the macro to add to the current value the current if there is any number.

so example:
master file:

Separate file:

How I want the result:

Instead of this 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
                                        Else
                                            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
        
        Wend
End Sub
Med vänliga hälsninga

Could someone help me


Thank you in advance


Best Regards


Daniel

 

[ask2tsp]

Daniel I changed your code somewhat to

Option Explicit

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
    
    'added missing declarations
    Dim masWb       As Workbook
    Dim masWbs      As Worksheet
    Dim x           As Long
    Dim y           As Long
    Dim cell        As Range
    Dim File        As String
    Dim res         As Variant  'row# in MastShRnG
    Dim iValue      As Variant  'value in column i (number/empty)
    Dim miValue     As Range    'i column cell in master
    '----------
    
    Set masWb = ThisWorkbook
    Set masWbs = masWb.Worksheets(1)
    
    x = masWbs.Range("H" & Rows.Count).End(xlUp).Row
    Set MastShRnG = masWbs.Range("H1:H" & x)
    
    'FolderPath = "C:\DATA\"
    FolderPath = "D:\users\ties\Documents\MrExcel\972051\"
    
    File = Dir(FolderPath)
    
    While (File <> "")
        Set SlaveWb = Workbooks.Open(FolderPath & File)
        Set SlaveWs = SlaveWb.Worksheets(1)
        y = SlaveWs.UsedRange.SpecialCells(xlCellTypeLastCell).Row
        Set SlavRng = SlaveWs.Range("H1:H" & y)
        
        For Each cell In SlavRng
            iValue = cell.Offset(0, 1)
            If IsNumeric(iValue) And cell.Value <> "" Then
                res = Application.Match(cell, MastShRnG, 0)
                
                If TypeName(res) <> "Error" Then
                    'code in slave already present in master
                    Set miValue = masWbs.Cells(res, "I")
                    miValue = IIf(miValue = "", iValue, miValue + iValue)
                    miValue.Interior.ColorIndex = 3
                Else
                    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
        
        Workbooks(File).Close SaveChanges:=False
        File = Dir
    Wend
End Sub

and it resulted in

Excel Workbook
	H	I
1	IO5	100
2	IO6	*
3	IO1	10
4	IO3	30
5	IO4	40
Sheet1

 

[ask2tsp]

Forgot to mention: change folderpath back to your path