Option Compare Text 'ignore text case
Function ValidAddress(strAddress As String) As Boolean
Dim r As Range
On Error Resume Next
Set r = Worksheets(1).Range(strAddress)
If Not r Is Nothing Then ValidAddress = True
End Function
Sub copymasterdata()
Dim mastersh As Worksheet
Dim receptorsh1 As Worksheet
Dim lastrow1 As Long
Dim masterdatacells As String
Dim recept1cols As String
Dim masterunbound As Variant
Dim recept1unbound As Variant
Dim receptstr As String
Dim maststr As String
Dim i As Long
Dim errmsg As String
Dim clearer As Long
Dim uidcol As String
Dim dupes As String
Set mastersh = Worksheets("Sheet1") 'set masterworksheet, change "Sheet1" to worksheet's actual name
Set receptorsh1 = Worksheets("Sheet2") 'set receptor sheet, change "Sheet2" to worksheet's actual name
masterdatacells = "A3, B3, C3, D3, E3, G3, H3, I3, J3, L3, M3, N3, O3, P3, Q3, R3, S3" 'these are the cells on the master sheet that will be copied
recept1cols = "A, B, C, D, E, G, H, I, J, L, M, N, O, P, Q, R, S" 'these the the columns to copy to on the receptor sheet
clearer = 0 'set to 1 to clear the master sheet entries after each run
uidcol = "" 'set to column letter of uid. Should also be first letter in recept1cols even if not in order.
'check for valid addresses and matching receptor1cols
masterunbound = Split(masterdatacells, ",")
recept1unbound = Split(recept1cols, ",")
If UBound(masterunbound) <> UBound(recept1unbound) Then
MsgBox "The master columns and the receptor1 columns aren't the same count." & vcbr & " Perhaps there is a missing comma", vbCritical, "ALERT"
Exit Sub
End If
For i = LBound(masterunbound) To UBound(masterunbound)
If ValidAddress(Trim(masterunbound(i))) = False Then
If errmsg = "" Then
errmsg = Trim(masterunbound(i))
Else
errmsg = errmsg & vbCr & Trim(masterunbound(i))
End If
End If
Next i
If errmsg <> "" Then
MsgBox "The following master cell addresses are invalid (may require comma):" & vbCr & "-----------------------" & vbCr & errmsg, vbCritical, "ALERT"
Exit Sub
End If
'unfilter receptor sheet if filtered -- make for each receptor sheet next 3 lines, change numbers
If receptorsh1.AutoFilterMode Then
receptorsh1.Cells.AutoFilter
End If
'determine last row of each receptorsheet -- make for each receptor sheet change numbers
lastrow1 = receptorsh1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row + 1
masterunbound = Split(masterdatacells, ",")
recept1unbound = Split(recept1cols, ",")
For i = LBound(masterunbound) To UBound(masterunbound)
receptstr = Trim(recept1unbound(i))
maststr = Trim(masterunbound(i))
'do uid check. Set UIDCOL at beginning of code
If Trim(uidcol) <> "" Then
If receptstr = uidcol Then
If IsError(Application.Match(mastersh.Range(maststr), receptorsh1.Range(receptstr & ":" & receptstr), 0)) = False Then
dupes = mastersh.Range(maststr)
GoTo ender:
Exit Sub
End If
End If
End If
receptorsh1.Cells(lastrow1, receptstr) = mastersh.Range(maststr)
If clearer = 1 Then
mastersh.Range(maststr) = ""
End If
Next i
ender:
If dupes <> "" Then
dupes = "Duplicate UID not added:" & vbCr & "------------------" & vbCr & dupes
Else
dupes = "Copied"
End If
MsgBox dupes, vbInformation, "CONFIRMATION"
End Sub
