route217
asked on
Macro to delete blank rows and run from drop down list
Hi Experts Using Excel 2013
See attached file
I want the macro to run from the drop down in sheet “Master” cell B2. i have the following code in the Worksheet module
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Call CopyandPasteValues
End If
End Sub
The following copy and paste macro works fine I believe See below…
But need to add function to remove blank rows from the data set, not sure how to integrate this part..
well this all work...
Test-1234.xlsx
See attached file
I want the macro to run from the drop down in sheet “Master” cell B2. i have the following code in the Worksheet module
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Call CopyandPasteValues
End If
End Sub
The following copy and paste macro works fine I believe See below…
Sub CopyandPasteValues()
Sheets("Data").Columns("AW").Copy
Sheets("Unique List").Range("$A$1:$A:$A$3500").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Unique List").Range("$A$1:$A$3500").RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlYes
End Sub
But need to add function to remove blank rows from the data set, not sure how to integrate this part..
well this all work...
Test-1234.xlsx
ASKER CERTIFIED SOLUTION
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
ASKER
Excellent the macro work but can i use the following to run the macro from a drop down list...
Add the following to ThisWorksheet
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Call CopyandPasteValues
End If
End Sub
Add the following to ThisWorksheet
That's because your drop down list is in B1 not in B2, so change the following line...
TO THIS
If Target.Address = "$B$2"
TO THIS
If Target.Address = "$B$1"
Right click the Master Tab --> View Code and place the following code into the opened code window.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$1" Then
Call CopyandPasteValues
End If
End Sub
ASKER
Many thank excellence feedback.
You're welcome. Glad to help.
SpecialCells will cause an error if no cells match the criteria so it's best to use an error handler. If an error occurs and the macro fails then Screen Updating will not be restored automatically. I would amend the code slightly
Option Explicit
Sub CopyandPasteValues()
On Error GoTo exit_proc
With Application
.ScreenUpdating = False
With Sheets("Unique List")
.Columns(1).ClearContents
Sheets("Data").Range("A:A").SpecialCells(xlCellTypeConstants).Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues
.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
End With
exit_proc:
MsgBox "An error occurred", vbCritical, "Quitting"
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
@Roy
There are so many ifs and buts...
like what if Sheet Unique List or Sheet Data doesn't exists in the workbook?
With the kind of error handling you included in your code will suppress the error only, if any, during the code execution and will prompt the user in the end that "An error occurred" but with no clue of what error has been occurred. In other words, this will only stop the debug window to appear.
Won't it be better if the error message also includes the Err.Description, I think then only your error handling makes any sense.
There are so many ifs and buts...
like what if Sheet Unique List or Sheet Data doesn't exists in the workbook?
With the kind of error handling you included in your code will suppress the error only, if any, during the code execution and will prompt the user in the end that "An error occurred" but with no clue of what error has been occurred. In other words, this will only stop the debug window to appear.
Won't it be better if the error message also includes the Err.Description, I think then only your error handling makes any sense.
Makes more sense than no error handling. It was only a quick suggestion
Amended code
Option Explicit
Sub CopyandPasteValues()
On Error GoTo exit_proc
On Error GoTo exit_proc
With Application
.ScreenUpdating = False
With Sheets("Unique List")
.Columns(1).ClearContents
Sheets("Data").Range("A:A").SpecialCells(xlCellTypeConstants).Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues
.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
End With
exit_proc:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CopyandPasteValues of Module Module1"
.CutCopyMode = False
.ScreenUpdating = True
End With
On Error GoTo 0
End Sub
I am happy that you got my point. :)
I didn't get your point, I was only trying to help the OP by suggesting a slight amendment to your code. Didn't expect criticism from you when I didn't start by criticizing your original post. My point was simply really to avoid an error using SpecialCells. I then noticed ScreenUpdating, which can be very confusing to a beginner if it is not restored by the code, I don't really see what advantage there is in using it with your code, but it wouldn't be a problem unless an un-trapped error occurred.
I've just spotted a typo in my code, it should be
Although I think this is all that is bneeded
Option Explicit
Sub CopyandPasteValues()
On Error GoTo exit_proc
With Sheets("Unique List")
.Columns(1).ClearContents
Sheets("Data").Range("A:A" ).SpecialC ells(xlCel lTypeConst ants).Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues
.Range("A:A").RemoveDuplic ates Columns:=1, Header:=xlYes
End With
exit_proc:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") . Probable cause is that no cells could be found for the macro to work with"
Application.CutCopyMode = False
On Error GoTo 0
End Sub
I've just spotted a typo in my code, it should be
Option Explicit
Sub CopyandPasteValues()
On Error GoTo exit_proc
With Application
.ScreenUpdating = False
With Sheets("Unique List")
.Columns(1).ClearContents
Sheets("Data").Range("A:A").SpecialCells(xlCellTypeConstants).Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues
.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
End With
exit_proc:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CopyandPasteValues of Module Module1"
.CutCopyMode = False
.ScreenUpdating = True
End With
On Error GoTo 0
End Sub
Although I think this is all that is bneeded
Option Explicit
Sub CopyandPasteValues()
On Error GoTo exit_proc
With Sheets("Unique List")
.Columns(1).ClearContents
Sheets("Data").Range("A:A"
.Range("A1").PasteSpecial Paste:=xlPasteValues
.Range("A:A").RemoveDuplic
End With
exit_proc:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") . Probable cause is that no cells could be found for the macro to work with"
Application.CutCopyMode = False
On Error GoTo 0
End Sub
haha
ASKER