Help Needed with VBA please help

Aug 27, 2021
Reaction score
I am new to VBA and this is the first Macro I've tried to write.

I have an excel table which has five columns titled Address, location , works , action and completed. I want to create a new worksheet for each unique address and then copy the relevant rows for that address on that new worksheet. However, I only want to copy and paste the unique rows if the value in "Completed" is "N". The Value in completed can only be "Y" or "N".

Here is the code I have written:
sub CreatePropertySheets()

Dim AddressField As Range
Dim AddressName As Range
Dim NewWSheet As Worksheet
Dim WSheet As Worksheet
Dim WSheetFound As Boolean
Dim DataWSheet As Worksheet

Set DataWSheet = Worksheets("Data")
Set AddressField = DataWSheet.Range("A4", DataWSheet.Range("A4").End(xlDown))

Application.ScreenUpdating = False

'Loop through each property name in column A

For Each AddressName In AddressField

'Check whether the current branch name corresponds with an existing sheet name

For Each WSheet In ThisWorkbook.Worksheets
If AddressName.Offset(, 4).Value = "N" Then
If WSheet.Name = AddressName Then
WSheetFound = True
Exit For
WSheetFound = False
End If
End If
Next WSheet

If WSheetFound Then

AddressName.Offset(0, 0).Resize(1, 5).Copy Destination:=Worksheets(AddressName.Value).Range("A3").End(xlDown).Offset(1, 0)


Set NewWSheet = Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
NewWSheet.Name = AddressName

DataWSheet.Range("A3", DataWSheet.Range("A3").End(xlToRight)).Copy Destination:=NewWSheet.Range("A3")
AddressName.Offset(0, 0).Resize(1, 5).Copy Destination:=NewWSheet.Range("A4") '
End If

Next AddressName

For Each WSheet In ThisWorkbook.Worksheets


Next WSheet

Application.ScreenUpdating = True

End Sub


Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question