0% found this document useful (0 votes)
23 views

Vba Code

Uploaded by

hippocrate1122
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
23 views

Vba Code

Uploaded by

hippocrate1122
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 5

Sub deletecolumns()

Sheets("All").Range("B:B,E:E,I:I,L:N").Delete
End Sub
Sub rowheight()
Range("a:a").EntireRow.rowheight = 15
Columns("A:J").AutoFit
Range("D:I").EntireColumn.ColumnWidth = 25
End Sub
Sub replacelate()
Columns("I:I").Select
Selection.Replace What:="Late", Replacement:="Late Comer", LookAt:= _
xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False

End Sub

Sub deleterows()
Dim r As Long ' Row
Dim m As Long ' Last row

'Or Range("E" & r).Value <> "SWABI"


'Or (Range("E" & r).Value <> "SWABI")

'Sheets("All").Range ("E:E")
m = Range("E" & Rows.Count).End(xlUp).row
'Range("E:E").Activate

'MsgBox ("the total rows are" & m)

For r = m To 2 Step -1

If ((Range("E" & r).Value <> "MARDAN") And (Range("E" & r).Value <> "SWABI")) Then
'If (Cells(r, 5).Value <> "MARDAN") Or (Cells(r, 5).Value <> "SWABI") Then

'If Range("E" & r).Value <> "SWABI" Then

Range("A" & r).EntireRow.Delete

'End If
End If
Next r
MsgBox ("the Rows delete are completed")

End Sub

Sub ArrangeColumn()

Columns("D:D").Select
Selection.Copy
Columns("J:J").Select
Selection.Insert Shift:=xlToRight

Columns("B:B").Select
Selection.Copy
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
End Sub
Sub ReplaceDHQValues()
Dim row As Long ' Row
Dim n As Long ' Last row

'Or Range("E" & r).Value <> "SWABI"


'Or (Range("E" & r).Value <> "SWABI")

'Sheets("All").Range ("E:E")
n = Range("E" & Rows.Count).End(xlUp).row
'Range("E:E").Activate

'MsgBox ("the total rows are" & m)

For row = n To 2 Step -1

If Range("L" & row).Value = "DHQ" Then

Range("L" & row).Offset(0, -4).Select


Selection.Copy
ActiveCell.Offset(0, -1).Select
ActiveSheet.Paste
Range("L" & row).Offset(0, 1).Value = "DHQ"

ElseIf Range("L" & row).Value = "FWC" Or Range("L" & row).Value = "MSU" Or


Range("L" & row).Value = "RHSC-A" Then

Range("L" & row).Offset(0, 1).Value = "PWD"


Else
Range("L" & row).Offset(0, 1).Value = "DHO"

End If
Next r

Range("H:H").Delete

End Sub
Sub ArrangeTotalData()

ActiveSheet.Range("B:B,E:E,I:I,L:N").Delete

Range("a:a").EntireRow.rowheight = 15
Columns("A:J").AutoFit
Range("D:I").EntireColumn.ColumnWidth = 25

Columns("I:I").Select
Selection.Replace What:="Late", Replacement:="Late Comer", LookAt:= _
xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False

Dim r As Long ' Row


Dim m As Long ' Last row

'Or Range("E" & r).Value <> "SWABI"


'Or (Range("E" & r).Value <> "SWABI")

'Sheets("All").Range ("E:E")
m = Range("E" & Rows.Count).End(xlUp).row
'Range("E:E").Activate

'MsgBox ("the total rows are" & m)

For r = m To 2 Step -1

If ((Range("E" & r).Value <> "MARDAN") And (Range("E" & r).Value <> "SWABI")) Then
'If (Cells(r, 5).Value <> "MARDAN") Or (Cells(r, 5).Value <> "SWABI") Then

'If Range("E" & r).Value <> "SWABI" Then

Range("A" & r).EntireRow.Delete

'End If
End If
Next r

Columns("D:D").Select
Selection.Copy
Columns("J:J").Select
Selection.Insert Shift:=xlToRight

Columns("B:B").Select
Selection.Copy
Columns("K:K").Select
Selection.Insert Shift:=xlToRight

Dim row As Long ' Row


Dim n As Long ' Last row

'Or Range("E" & r).Value <> "SWABI"


'Or (Range("E" & r).Value <> "SWABI")

'Sheets("All").Range ("E:E")
n = Range("E" & Rows.Count).End(xlUp).row
'Range("E:E").Activate

'MsgBox ("the total rows are" & m)

For row = n To 2 Step -1

If Range("L" & row).Value = "DHQ" Then

Range("L" & row).Offset(0, -4).Select


Selection.Copy
ActiveCell.Offset(0, -1).Select
ActiveSheet.Paste
Range("L" & row).Offset(0, 1).Value = "DHQ"
ElseIf Range("L" & row).Value = "FWC" Or Range("L" & row).Value = "MSU" Or
Range("L" & row).Value = "RHSC-A" Then

Range("L" & row).Offset(0, 1).Value = "PWD"


Else
Range("L" & row).Offset(0, 1).Value = "DHO"

End If
Next row

Range("H:H").Delete

Range("L1").Value = "Department"

Rows("1:1").Select
Selection.AutoFilter

ActiveSheet.Range("$A$1:$R$615").AutoFilter Field:=5, Criteria1:="SWABI"

Range("A1").Select
Range("A1").CurrentRegion.Select
Selection.Copy
Sheets.Add(After:=ActiveSheet).Name = "SWABI AbsentStaff List"
'Range("A1").Select
'Sheets("All").Range("a1").CurrentRegion.Select

Sheets("SWABI AbsentStaff List").Select


ActiveSheet.Paste
Rows("1:1").Select
Selection.AutoFilter

Range("a:a").EntireRow.rowheight = 15

Range("A:L").EntireColumn.ColumnWidth = 25

Sheets("All").Activate
ActiveSheet.ShowAllData

Rows("1:1").Select
Selection.AutoFilter

ActiveSheet.Range("$A$1:$R$615").AutoFilter Field:=5, Criteria1:="MARDAN"

Range("A1").Select
Range("A1").CurrentRegion.Select
Selection.Copy
Sheets.Add(After:=ActiveSheet).Name = "Mardan AbsentStaff List"
'Range("A1").Select
'Sheets("All").Range("a1").CurrentRegion.Select

Sheets("Mardan AbsentStaff List").Select


ActiveSheet.Paste

Rows("1:1").Select
Selection.AutoFilter

Range("a:a").EntireRow.rowheight = 15

Range("A:L").EntireColumn.ColumnWidth = 25

Sheets("All").Activate
ActiveSheet.ShowAllData

End Sub

You might also like