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 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:
Could someone help me thank you in advance?
Best regards
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 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:
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 SubCould someone help me thank you in advance?
Best regards
