D
davegb
I've got a macro to extract records from a datasheet based on input
from another worksheet. Basically, it's crude, but it works! Surprise!
At least it works when there's data to extract.
Now, I'm trying to get it to check and see if the cell in the selected
row Column F contains data. If there's no data there, there's no data
to extract. I added an If Then Else statement bracketing the extract
routine, with the Else bringing up a Msgbox telling the user there are
no records to extract. But I keep getting an error message when I run
it when the appropriate Column F cell is blank. I want it to skip the
entire routine and to the the Else line if that happens, but it
obviously doesn't.
Here's the code:
Sub RecurExtract()
'Password used
Dim CtyCode As String
Dim WkSht As Object
Dim PWORD As String
Dim CurRow As Integer
PWORD = "dave"
CurRow = ActiveCell.Row
CtyCode = ActiveCell
If ActiveSheet.Cells(CurRow, "F") <> "" Then
Set WkSht = ActiveWorkbook.Sheets("Recurrence Records")
WkSht.Unprotect Password:=PWORD
Sheets("Recurrence Records").Range("S2") = CtyCode
WkSht.Protect Password:=PWORD
Sheets("County Records").Select
Worksheets("County Records").UsedRange.Clear
Range("a1:i1").Merge
Range("a1").FormulaR1C1 = _
"WARNING: This data will be erased the next time
County Records are extracted. "
With Range("a1").Characters(Start:=1, Length:=78).Font
.FontStyle = "Bold"
.ColorIndex = 7
End With
Range("A2:I2").Merge
Range("A2").FormulaR1C1 = _
"If you wish to save the data, copy and paste it to
another spreadsheet or print it out before doing another data
extraction."
With Range("A2").Characters(Start:=1, Length:=124).Font
.ColorIndex = 7
End With
Sheets("Recurrence
Records").Range("A1:M192").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Recurrence
Records").Range("S1:S2"), _
CopyToRange:=Range("A5"), Unique:=False
Range("A4:E4").Merge
Range("a4") = CtyCode & " County Recurrence Records"
With Range("a4").Characters(Start:=1, Length:=78).Font
.FontStyle = "Bold"
End With
Columns("A:M").EntireColumn.AutoFit
Range("A5:M5").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Font.Bold = True
End With
Rows("5:5").RowHeight = 24.75
HANGS UP HERE--->Worksheets("Recurrence
Records").Range("A195:A199").Copy Destination:= _
Worksheets("County Records").Range("a5") _
.End(xlDown).Offset(2, 0)
Range("a1").Select
Else
MsgBox "There are no records for " & CtyCode, vbOKOnly
End If
End Sub
When it gets to the line where HANGS UP HERE is, I get an "application
defined or object defined error". But I don't want it to see this code
if the data field is blank. I want it to skip to "Else" and open the
Msgbox.
Any ideas?
Thanks for your help.
from another worksheet. Basically, it's crude, but it works! Surprise!
At least it works when there's data to extract.
Now, I'm trying to get it to check and see if the cell in the selected
row Column F contains data. If there's no data there, there's no data
to extract. I added an If Then Else statement bracketing the extract
routine, with the Else bringing up a Msgbox telling the user there are
no records to extract. But I keep getting an error message when I run
it when the appropriate Column F cell is blank. I want it to skip the
entire routine and to the the Else line if that happens, but it
obviously doesn't.
Here's the code:
Sub RecurExtract()
'Password used
Dim CtyCode As String
Dim WkSht As Object
Dim PWORD As String
Dim CurRow As Integer
PWORD = "dave"
CurRow = ActiveCell.Row
CtyCode = ActiveCell
If ActiveSheet.Cells(CurRow, "F") <> "" Then
Set WkSht = ActiveWorkbook.Sheets("Recurrence Records")
WkSht.Unprotect Password:=PWORD
Sheets("Recurrence Records").Range("S2") = CtyCode
WkSht.Protect Password:=PWORD
Sheets("County Records").Select
Worksheets("County Records").UsedRange.Clear
Range("a1:i1").Merge
Range("a1").FormulaR1C1 = _
"WARNING: This data will be erased the next time
County Records are extracted. "
With Range("a1").Characters(Start:=1, Length:=78).Font
.FontStyle = "Bold"
.ColorIndex = 7
End With
Range("A2:I2").Merge
Range("A2").FormulaR1C1 = _
"If you wish to save the data, copy and paste it to
another spreadsheet or print it out before doing another data
extraction."
With Range("A2").Characters(Start:=1, Length:=124).Font
.ColorIndex = 7
End With
Sheets("Recurrence
Records").Range("A1:M192").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Recurrence
Records").Range("S1:S2"), _
CopyToRange:=Range("A5"), Unique:=False
Range("A4:E4").Merge
Range("a4") = CtyCode & " County Recurrence Records"
With Range("a4").Characters(Start:=1, Length:=78).Font
.FontStyle = "Bold"
End With
Columns("A:M").EntireColumn.AutoFit
Range("A5:M5").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Font.Bold = True
End With
Rows("5:5").RowHeight = 24.75
HANGS UP HERE--->Worksheets("Recurrence
Records").Range("A195:A199").Copy Destination:= _
Worksheets("County Records").Range("a5") _
.End(xlDown).Offset(2, 0)
Range("a1").Select
Else
MsgBox "There are no records for " & CtyCode, vbOKOnly
End If
End Sub
When it gets to the line where HANGS UP HERE is, I get an "application
defined or object defined error". But I don't want it to see this code
if the data field is blank. I want it to skip to "Else" and open the
Msgbox.
Any ideas?
Thanks for your help.