Print rows of missing info
see ********* fort comments
Sub Employees()
Dim lastRow As Long
' Employees Macro
'
' Keyboard Shortcut: Ctrl+e
'
' This deletes all columns where in the row any blank cells
Rows(1).SpecialCells(xlCellTypeBlanks).EntireColum n.Delete
Rows(1).EntireRow.Delete
'******* rows (1) of what - must be specific about what you are working
on?
'*******I think this will just delete the first row of the active sheet
'Set Name "Employees" for NEW Range
With Worksheets("Employees")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:D" & lastRow).Name = "Employees"
End With
'****** probably best to use the current region range object rather than a
named range?
Dim rng As Range
Set rng = Worksheets("Employees").Cells(1, 1).CurrentRegion
'******* You can then do all sorting etc using this range
' Sort_Employees by department code in column C
'
ActiveSheet.Range("Employees").Sort _
Key1:=Columns("C"), _
Order1:=xlAscending, _
DataOption1:=xlSortNormal, _
Header:=xlNo
' Enter here routine for determining missing DEPARTMENT CODE
Application.Run "PrintAndExitIfBlankEmplyeeData"
'****** Just PrintAndExitIfBlankEmplyeeData
'***** no need for Application.Run or quotes
' Enter Formula to Column D
Range("D1").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'G:\Personel\cav index.xlsx'!accounts,2)"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'********** Can't see what this is doing
'********** Generally better not to select but to work on ranges see above
' Sort_Employees by SI
'
ActiveSheet.Range("Employees").Sort _
Key1:=Range("A1", "Employees"), _
Order1:=xlAscending, _
DataOption1:=xlSortNormal, _
Header:=xlNo
' Save Active Wrokbook and close Window
ActiveWorkbook.Save
ActiveWindow.Close
Application.Quit
End Sub
"Helmut" wrote:
DomThePom,
Here is my code now. It works up to
Application.Run "PrintAndExitIfBlankEmplyeeData"
but does NOT execute it.
somehow something is wrong. Can you help? thanks here it is:
---------------------------------------------------------------------------
Sub Employees()
'
' Employees Macro
'
' Keyboard Shortcut: Ctrl+e
'
' This deletes all columns where in the row any blank cells
Rows(1).SpecialCells(xlCellTypeBlanks).EntireColum n.Delete
Rows(1).EntireRow.Delete
' Set Name "Employees" for NEW Range
With Worksheets("Employees")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:D" & lastrow).Name = "Employees"
End With
' Sort_Employees by department code in column C
'
ActiveSheet.Range("Employees").Sort _
Key1:=Columns("C"), _
Order1:=xlAscending, _
DataOption1:=xlSortNormal, _
Header:=xlNo
' Enter here routine for determining missing DEPARTMENT CODE
Application.Run "PrintAndExitIfBlankEmplyeeData"
' Enter Formula to Column D
Range("D1").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'G:\Personel\cav index.xlsx'!accounts,2)"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
' Sort_Employees by SI
'
ActiveSheet.Range("Employees").Sort _
Key1:=Range("A1", "Employees"), _
Order1:=xlAscending, _
DataOption1:=xlSortNormal, _
Header:=xlNo
' Save Active Wrokbook and close Window
ActiveWorkbook.Save
ActiveWindow.Close
Application.Quit
End Sub
----------
Sub PrintAndExitIfBlankEmplyeeData()
Dim rngRow As Range
Dim rng As Range
Set rng = Range("Employees")
If CountBlanksCells(rng) < 0 Then
'hide complete rows
For Each rngRow In rng.Rows
'exclude first row
If rngRow.Row < 1 Then
If CountBlanksCells(rngRow) = 0 Then
rngRow.EntireRow.Hidden = True
End If
End If
Next rngRow
Range("Employees").Resize(, 2).PrintOut
Application.DisplayAlerts = False
Application.Quit
End If
End Sub
Function CountBlanksCells(ByRef rng As Range) As Long
Dim lngCount As Long
On Error Resume Next
lngCount = rng.SpecialCells(xlCellTypeBlanks).Cells.Count
If Err.Number = 0 Then
CountBlanksCells = lngCount
Else
CountBlanksCells = 0
End If
On Error GoTo 0
End Function
---------------------------------------------------------------------------
"DomThePom" wrote:
I have just copied exactly what was in the post to a blank module, removed
the ''s and not got any compile errors.
Are you sure that you pasted both the:
Sub PrintAndExitIfBlankEmplyeeData
and the:
Function CountBlanksCells
into your mudule ?
Clearly, if you pasted the sub and not the function then you will get a
compile error!
"Helmut" wrote:
Hi,
I am getting a "compile error" : Sub or Function not defined against:
If CountBlanksCells(rng) < 0 Then
Help please... thanks
Helmut
"DomThePom" wrote:
Ask and ye......
Sub PrintAndExitIfBlankEmplyeeData()
Dim rngRow As Range
Dim rng As Range
Set rng = Range("Employees")
If CountBlanksCells(rng) < 0 Then
'hide complete rows
For Each rngRow In rng.Rows
'exclude first row
If rngRow.row < 1 Then
If CountBlanksCells(rngRow) = 0 Then
rngRow.EntireRow.Hidden = True
End If
End If
Next rngRow
Range("Employees").Resize(, 2).PrintOut
Application.DisplayAlerts = False
Application.Quit
End If
End Sub
Function CountBlanksCells(ByRef rng As Range) As Long
Dim lngCount As Long
On Error Resume Next
lngCount = rng.SpecialCells(xlCellTypeBlanks).Cells.Count
If Err.Number = 0 Then
CountBlanksCells = lngCount
Else
CountBlanksCells = 0
End If
On Error GoTo 0
End Function
"Helmut" wrote:
Hi DomThePom,
Great BUT it prints not only the rows with the BLANK CELL but it prints the
whole worksheet. I only want to print the rows with the blank cells.
thanks
Helmut
"DomThePom" wrote:
Here you go Helmut:
Sub PrintAndExitIfBlankEmplyeeData()
Dim rng As Range
Set rng = Range("Employees")
If rng.SpecialCells(xlCellTypeBlanks).Cells.Count < 0 Then
Range("Employees").Resize(, 2).PrintOut
Application.DisplayAlerts = False
Application.Quit
End If
End Sub
"Helmut" wrote:
Hi,
I have a RANGE "Employees" with some missing info:
Column A Columns B Column C
21823059 גדעון לי*א 474
27640374 מיעארי טארק 474
36095008 מורא*י רים 474
15786791 פוקס מיכל blank cell
27820257 הראל שלומציון blank cell
28488567 אר*פרוי*ד רו*ית blank cell
I would like that IF NO blank cells in Range THEN continue MACRO
but IF blank cells in Range THEN "print" value of cells A and B and Exit
both Worksheet and Excel.
|