Hello,
I am very new to VBA code and would greatly appreciate any help you are able to offer. I have a master contacts workbook and would like the ability to add new contacts to sheet 1 and then, based on criteria that was entered in specific columns, have that data automatically be added to the additional appropriate sheets within the workbook. I would like the spreadsheet to auto-update and I would also like for only the first couple of columns for each row to be copied over to additional sheets.
I've attached an example spreadsheet. Eharwood_VBA code sample file.xlsx
I have columns for first name, last name, and contact info. Then there are columns that tag the individual as a member/non-member and based on participation in various committees there is a yes or no for each committee column.
For the first row of my example spreadsheet John Smith is a tagged as a member (per column H) and also a member of the Promotions committee (a yes in column K). Therefore, I would like the ability to have John Smith's information automatically added to the member sheet and also to the promotions sheet. I also only want to copy the info from columns A-G to each additional sheet in the workbook.
Based on extensive googling below is the code that I am attempting to use, but I receive an error message and I also feel like there is a much more efficient way to accomplish the same thing. Any suggestions and help are greatly appreciated!
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim i, LastRow
LastRow = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row
Sheets("GRMCA Members").Range("A2:G500").ClearContents
For i = 2 To LastRow
If Sheets("Master").Cells(i, "H").Value = "Member" Then
Sheets("Master").Cells(i, "H").EntireRow.Copy Destination:=Sheets("GRMCA Members").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
LastRow = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Non-Members").Range("A2:G500").ClearContents
For i = 2 To LastRow
If Sheets("Master").Cells(i, "H").Value = "Non-Member" Then
Sheets("Master").Cells(i, "H").EntireRow.Copy Destination:=Sheets("Non-Members").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
LastRow = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row
Sheets("EOS").Range("A2:G500").ClearContents
For i = 2 To LastRow
If Sheets("Master").Cells(i, "I").Value = "Yes" Then
Sheets("Master").Cells(i, "I").EntireRow.Copy Destination:=Sheets("EOS").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
LastRow = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row
Sheets("TAC").Range("A2:G500").ClearContents
For i = 2 To LastRow
If Sheets("Master").Cells(i, "J").Value = "Yes" Then
Sheets("Master").Cells(i, "J").EntireRow.Copy Destination:=Sheets("TAC").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
LastRow = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Promotions").Range("A2:G500").ClearContents
For i = 2 To LastRow
If Sheets("Master").Cells(i, "K").Value = "Yes" Then
Sheets("Master").Cells(i, "K").EntireRow.Copy Destination:=Sheets("Promotions").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
LastRow = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Yardage").Range("A2:G500").ClearContents
For i = 2 To LastRow
If Sheets("Master").Cells(i, "L").Value = "Yes" Then
Sheets("Master").Cells(i, "L").EntireRow.Copy Destination:=Sheets("Yardage").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End Sub
Thank you,
Bookmarks