The code below runs and executes perfectly, I just want to add some features. The code imports the new rows from Report file to Workbook file, and I want it to check for a potential row with new data by every cell in the row, and not by just column G(contains number or numbers separated by comma), but in range A2:BQ. Also update the newly found cells even if the row exists in Workbook by the number in column G. Also to highlight the new rows with a bright color in the Workbook file. One last thing is to wrap the text after the importing of new cells finishes.
Sub Weekly_Report()
Const HAS_HEADER As Boolean = True 'Set true if the file has a header(Report)
Const NUM_COLS As Long = 69 '69 rows needed to be imported from the Report
Const FILENAME = "Report.xlsx"
Const PATH = "C:\Users\Documents\" 'path of the report
Dim wbReport As Workbook, wsReport As Worksheet, wsData As Worksheet
Dim next_blank_row As Long, iStartRow As Long, iLastRow As Long, iRow As Long
Dim sFilename As String
Set wsData = ThisWorkbook.Worksheets("Sheet1") 'for example: destination worksheet
next_blank_row = wsData.Cells(Rows.Count, "G").End(xlUp).Row + 1 'next blank row
sFilename = PATH & FILENAME
Debug.Print "Opening ", sFilename 'Openning file
On Error Resume Next
Set wbReport = Workbooks.Open(sFilename)
On Error GoTo 0
If wbReport Is Nothing Then
MsgBox "Can not open " & sFilename, vbCritical, "ERROR" 'If the file was not found or cannot be opened
Exit Sub
End If
Set wsReport = wbReport.Worksheets(1) 'Expects only one sheet in the Report
iStartRow = IIf(HAS_HEADER, 2, 1) 'If it has header start from row 2
iLastRow = wsReport.Cells(Rows.Count, 1).End(xlUp).Row
Dim s As String, rng As Range, m As Long
For iRow = iStartRow To iLastRow
s = CStr(wsReport.Cells(iRow, "G").Value)
Set rng = wsData.Columns("A:BQ").Find(s)
If rng Is Nothing Then
m = next_blank_row 'no match - use next blank row and increment
next_blank_row = next_blank_row + 1
Debug.Print iRow, s, "New row " & m
Else
m = rng.Row
Debug.Print iRow, s, "Match row " & m 'Match row:if the line already exists in the file
End If
wsData.Cells(m, 1).Resize(1, NUM_COLS).Value = wsReport.Cells(iRow, 1).Resize(1, NUM_COLS).Value 'Put the new line in Workbook
Next
MsgBox wsReport.Name & " scanned from row " & iStartRow & _
" to " & iLastRow, vbInformation, sFilename
wbReport.Close False 'Close the Report
End Sub
This updates column P and S for rows matching column G or adds the rows if no match.
Option Explicit
Sub Weekly_Report()
Const HAS_HEADER As Boolean = True 'Set true if the file has a header(Report)
Const NUM_COLS As Long = 69 '69 cells in the row needed to be imported from the Report
Const FILENAME = "Report.xlsx"
Const PATH = "C:\Users\Documents\" 'path of the report
Dim wbReport As Workbook, wsReport As Worksheet, wsData As Worksheet
Dim next_blank_row As Long, iStartRow As Long, iLastRow As Long, iRow As Long
Dim sFilename As String
Set wsData = ThisWorkbook.Worksheets("Sheet1") 'for example: destination worksheet
next_blank_row = wsData.Cells(Rows.Count, "G").End(xlUp).Row + 1 'next blank row
sFilename = PATH & FILENAME
Debug.Print "Opening ", sFilename 'Openning file
On Error Resume Next
Set wbReport = Workbooks.Open(sFilename)
On Error GoTo 0
If wbReport Is Nothing Then
MsgBox "Can not open " & sFilename, vbCritical, "ERROR" 'If the file was not found or cannot be opened
Exit Sub
End If
Set wsReport = wbReport.Worksheets(1) 'Expects only one sheet in the Report
iStartRow = IIf(HAS_HEADER, 2, 1) 'If it has header start from row 2
iLastRow = wsReport.Cells(Rows.Count, 1).End(xlUp).Row
Dim rng As Range, rng2 As Range, rng3 As Range
Dim m As Long, m2 As String, m3 As String, s As String, s2 As String, s3 As String, c As Variant
Dim iAdd As Long, iUpdate As Long
For iRow = iStartRow To iLastRow
s = CStr(wsReport.Cells(iRow, "G").Value)
Set rng = wsData.Columns("G").Find(s)
If rng Is Nothing Then
m = next_blank_row 'no match - use next blank row and increment
next_blank_row = next_blank_row + 1
With wsData.Cells(m, 1).Resize(1, NUM_COLS)
.Value = wsReport.Cells(iRow, 1).Resize(1, NUM_COLS).Value
.Interior.Color = vbYellow
End With
iAdd = iAdd + 1
Debug.Print iRow, s, "New row " & m
Else
m = rng.Row
For Each c In Array("P", "S")
If wsData.Cells(m, c) <> CStr(wsReport.Cells(iRow, c).Value) Then
wsData.Cells(m, c) = CStr(wsReport.Cells(iRow, c).Value)
wsData.Cells(m, c).Interior.Color = vbGreen
iUpdate = iUpdate + 1
End If
Next
Debug.Print iRow, s, "Match row " & m 'Match row:if the line already exists in the file
End If
Next
MsgBox wsReport.Name & " scanned from row " & iStartRow & _
" to " & iLastRow & vbCrLf & "added rows = " & iAdd & vbCrLf & _
"updated cells = " & iUpdate, vbInformation, sFilename
wbReport.Close False 'Close the Report
End Sub