' the following line is the macro name
Sub UpdateSheet2Sheet3()
' the following line is a way for me to keep track of the macros
' date
' MrExcel thread number
' hiker95, 04/18/2014, ME771379
' it is a good practice to delcare all your variables
' if there was a problem in your code, then someone with experience
' could help to repair a problem
' the following 3 are worksheet variables
Dim w1 As Worksheet, w2 As Worksheet, w3 As Worksheet
' c is a range object used to loop vertically in Sheet1 = w1, in column N
' nrng is a range object to search vertically in Sheet2 = w2, in column N
Dim c As Range, nrng As Range
' lr1 is used to find the last row in Sheet1 = w1
' lr2 is used to find the last row in Sheet2 = w2
' lr3 is used to find the last row in Sheet3 = w3
' nr is used to find the next available blank row in Sheet3 = w3
Dim lr1 As Long, lr2 As Long, lr3 As Long, nr As Long
' turn off screen updating, and, screen flickering when the macro is running
Application.ScreenUpdating = False
' set the worksheet variables to their respective worksheets
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
Set w3 = Sheets("Sheet3")
' In Sheet3 = w3
With w3
' find the last used row in Sheet3, column A
lr3 = .Cells(Rows.Count, "A").End(xlUp).Row
' if the last used row is greater than the title row
' then clear range A2:G lr3
If lr3 > 1 Then .Range("A2:G" & lr3).ClearContents
End With
' In Sheet2 = w2
With w2
' find the last used row in Sheet2, column B
lr2 = .Cells(Rows.Count, "B").End(xlUp).Row
' Concatenate/join in each row in column N, my work areas, in R1C1 notation
' Column B and Column C data for searching
With .Range("N2:N" & lr2)
.FormulaR1C1 = "=RC[-12]&RC[-11]"
' change the R1C1 notation to a value
.Value = .Value
End With
End With
' In Sheet1 = w1
With w1
' find the last used row in Sheet1, column B
lr1 = .Cells(Rows.Count, "B").End(xlUp).Row
' Concatenate/join in each row in column N, my work areas, in R1C1 notation
' Column B and Column C data for searching
With .Range("N2:N" & lr1)
.FormulaR1C1 = "=RC[-12]&RC[-11]"
' change the R1C1 notation to a value
.Value = .Value
End With
' loop thru range N2:N16
For Each c In .Range("N2:N" & lr1)
' if the cell is not empty/blank
If c <> "" Then
' search what is in column N, cell N2
' in w2 column N
Set nrng = w2.Columns("N:N").Find(c, LookAt:=xlWhole)
' if the search finds a match in w2 column N
If Not nrng Is Nothing Then
' copy w1 range H c.Row thru M c.Row
' to w2 range H nrng.Row
.Range("H" & c.Row).Resize(, 6).Copy w2.Range("H" & nrng.Row)
Application.CutCopyMode = False
End If
End If
Next c
End With
' clear the work areas in w1 and w2 in column N
w1.Range("N2:N" & lr1).ClearContents
w2.Range("N2:N" & lr2).ClearContents
' in w2 = Sheet2
With w2
' loop thru the cells in row 1 thru the lr2
For r = 2 To lr2
' If column H row is blank
If .Cells(r, 8) = "" Then
' find the next available blank row in Sheet3 = w3
' in column A
nr = w3.Cells(w3.Rows.Count, "A").End(xlUp).Row + 1
' copy range A thru G of the r row to
' the next available row
' in Sheet3 = w3
' in column A
.Range("A" & r & ":G" & r).Copy w3.Range("A" & nr)
' remove whatever is in the copy buffer
Application.CutCopyMode = False
End If
Next r
' autofit all the columns in Sheet3 = w3
.Columns("H:M").AutoFit
' Activate/Select Sheet3 = w3
.Activate
End With
' turn Screen Updating back on
Application.ScreenUpdating = True
End Sub
