Need code to be Shorten

V

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,284
Office Version
  1. 365
Platform
  1. Windows
can any one please shorten this code in professional way please..

Code: 
Sub datacollect()
Application.ScreenUpdating = False
Application.DisplayAlerts = False


Sheets("Surety").Visible = True
Sheets("Lossrun").Visible = True
Sheets("OPT").Visible = True


Surety
ActiveWorkbook.Sheets("Surety").Select
Range(("A1:W1"), Selection.End(xlDown)).Select
Selection.EntireRow.Delete
    Range("A1").Select


Dim i As Long


Dim path_name(3) As String


Dim sheet_name(2) As String
Dim sheet_name(3) As String
path_name(1) = Workbooks("Quality Dashboard Consolidated file v1.xlsb").Sheets("Home").Range("C42").Value
path_name(2) = Workbooks("Quality Dashboard Consolidated file v1.xlsb").Sheets("Home").Range("C42").Value
path_name(3) = Workbooks("Quality Dashboard Consolidated file v1.xlsb").Sheets("Home").Range("C42").Value


Dim sheet_name(3) As String
sheet_name(1) = "Surety.xlsx"
sheet_name(2) = "Lossrun.xlsx"
sheet_name(3) = "OPT.xlsx"




Workbooks.Open Filename:= _
path_name(1) & sheet_name(1)
Sheets("MI Raw data").Select
Range("A1").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"


lastrow_s = Sheets("MI Raw data").Cells(ActiveSheet.Rows.count, "A").End(xlUp).Row
Range("A1:W" & lastrow_s).Select
Selection.Copy


Workbooks("Quality Dashboard Consolidated file v1.xlsb").Activate
Sheets("Surety").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False


        Application.CutCopyMode = False


   Range("A1").Select
Workbooks("" & sheet_name(1)).Close




ActiveWorkbook.Sheets("Surety").Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("D:D").Select
    Selection.Copy
    Range("AK1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
        
ActiveWorkbook.Sheets("Surety").Columns("AK:AK").Select
 Selection.TextToColumns Destination:=Range("AK1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    Columns("AK:AK").Select
    Selection.NumberFormat = "m/d/yyyy"
    
    ActiveWorkbook.Sheets("Surety").Columns("AK:AL").Select
    Selection.Copy
    Range("E1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
     Application.CutCopyMode = False
    ActiveWorkbook.Sheets("Surety").Columns("E:E").Select
    Selection.Copy
    Range("D1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("D1").Value = "QC Checklist Submissions Date"
    Range("E1").Value = "QC_Start_Date"
    Range("F1").Value = "QC_Start_Time"
    ActiveWorkbook.Sheets("Surety").Columns("AK:AM").Select
    Selection.ClearContents
    ActiveWorkbook.Sheets("Surety").Columns("G:G").Select
     Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    
    ActiveWorkbook.Sheets("Surety").Columns("J:J").Select
    Selection.Copy
    Range("AK1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
        
ActiveWorkbook.Sheets("Surety").Columns("AK:AK").Select
 Selection.TextToColumns Destination:=Range("AK1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    Columns("AK:AK").Select
    Selection.NumberFormat = "m/d/yyyy"
    ActiveWorkbook.Sheets("Surety").Columns("AK:AL").Select
    Selection.Copy
    Range("G1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
     Application.CutCopyMode = False
     ActiveWorkbook.Sheets("Surety").Columns("AK:AM").Select
    Selection.ClearContents
     Range("G1").Value = "Last_Updated_Date"
    Range("H1").Value = "Last_Updated_Time"
        Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWorkbook.Sheets("Surety").Columns("P:P").Select
    Selection.Copy
    Columns("AC:AC").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("AC1").Value = "Supervisor Backup"
    
     ActiveWorkbook.Sheets("Surety").Columns("P:P").Select
     Selection.Delete Shift:=xlToLeft
    
    ActiveWorkbook.Sheets("Surety").Columns("R:R").Select
    Selection.Insert Shift:=xlToRight
    Columns("S:S").Select
    Selection.Copy
    Columns("R:R").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    ActiveWorkbook.Sheets("Surety").Columns("K:K").Select
    Selection.Copy
    Columns("AB:AB").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("AB1").Value = "Office Backup"
    Range("AA1").Value = "Unique count"
    Range("AA2").Value = 1
    Range("AA3") = "=AA2 + 1"
    Range("AA3").Copy
    Range("AB3").Select
    Selection.End(xlDown).Offset(0, -1).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    
Lossrun
ActiveWorkbook.Sheets("Lossrun").Select
Range(("A1:W1"), Selection.End(xlDown)).Select
Selection.EntireRow.Delete
    Range("A1").Select






For i = 2 To 3


Workbooks.Open Filename:= _
path_name(2) & sheet_name(2)
Sheets("MI Raw data").Select
Range("A1").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"


lastrow_s = Sheets("MI Raw data").Cells(ActiveSheet.Rows.count, "A").End(xlUp).Row
Range("A1:W" & lastrow_s).Select
Selection.Copy


Workbooks("Quality Dashboard Consolidated file v1.xlsb").Activate
Sheets("Lossrun").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False


        Application.CutCopyMode = False


   Range("A1").Select
Workbooks("" & sheet_name(2)).Close




ActiveWorkbook.Sheets("Lossrun").Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("D:D").Select
    Selection.Copy
    Range("AK1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
        
ActiveWorkbook.Sheets("Lossrun").Columns("AK:AK").Select
 Selection.TextToColumns Destination:=Range("AK1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    Columns("AK:AK").Select
    Selection.NumberFormat = "m/d/yyyy"
    
    ActiveWorkbook.Sheets("Lossrun").Columns("AK:AL").Select
    Selection.Copy
    Range("E1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
     Application.CutCopyMode = False
    ActiveWorkbook.Sheets("Lossrun").Columns("E:E").Select
    Selection.Copy
    Range("D1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("D1").Value = "QC Checklist Submissions Date"
    Range("E1").Value = "QC_Start_Date"
    Range("F1").Value = "QC_Start_Time"
    ActiveWorkbook.Sheets("Lossrun").Columns("AK:AM").Select
    Selection.ClearContents
    ActiveWorkbook.Sheets("Lossrun").Columns("G:G").Select
     Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    
    ActiveWorkbook.Sheets("Lossrun").Columns("J:J").Select
    Selection.Copy
    Range("AK1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
        
ActiveWorkbook.Sheets("Lossrun").Columns("AK:AK").Select
 Selection.TextToColumns Destination:=Range("AK1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    Columns("AK:AK").Select
    Selection.NumberFormat = "m/d/yyyy"
    ActiveWorkbook.Sheets("Lossrun").Columns("AK:AL").Select
    Selection.Copy
    Range("G1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
     Application.CutCopyMode = False
     ActiveWorkbook.Sheets("Lossrun").Columns("AK:AM").Select
    Selection.ClearContents
     Range("G1").Value = "Last_Updated_Date"
    Range("H1").Value = "Last_Updated_Time"
        Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWorkbook.Sheets("Lossrun").Columns("P:P").Select
    Selection.Copy
    Columns("AC:AC").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("AC1").Value = "Supervisor Backup"
    
     ActiveWorkbook.Sheets("Lossrun").Columns("P:P").Select
     Selection.Delete Shift:=xlToLeft
    
    ActiveWorkbook.Sheets("Lossrun").Columns("R:R").Select
    Selection.Insert Shift:=xlToRight
    Columns("S:S").Select
    Selection.Copy
    Columns("R:R").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    ActiveWorkbook.Sheets("Lossrun").Columns("K:K").Select
    Selection.Copy
    Columns("AB:AB").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("AB1").Value = "Office Backup"
    Range("AA1").Value = "Unique count"
    Range("AA2").Value = 1
    Range("AA3") = "=AA2 + 1"
    Range("AA3").Copy
    Range("AB3").Select
    Selection.End(xlDown).Offset(0, -1).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    
    
    
OPT
ActiveWorkbook.Sheets("OPT").Select
Range(("A1:W1"), Selection.End(xlDown)).Select
Selection.EntireRow.Delete
    Range("A1").Select






Dim sheet_name(3) As String
Dim sheet_name(2) As String
Dim sheet_name(3) As String


path_name(3) = "\\inmum-i-fs4\group$\WNA Skyline\WNA - Output Support\Common\Dashboard\Quality Dashboard\Quality Dashboard Raw data\2017\3.Mar'17\Test\"


sheet_name(3) = "OPT.xlsx"
sheet_name(2) = "OPT.xlsx"
sheet_name(3) = "OPT.xlsx"




Workbooks.Open Filename:= _
path_name(1) & sheet_name(3)
Sheets("MI Raw data").Select
Range("A1").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"


lastrow_s = Sheets("MI Raw data").Cells(ActiveSheet.Rows.count, "A").End(xlUp).Row
Range("A1:W" & lastrow_s).Select
Selection.Copy


Workbooks("Quality Dashboard Consolidated file v1.xlsb").Activate
Sheets("OPT").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False


        Application.CutCopyMode = False


   Range("A1").Select
Workbooks("" & sheet_name(3)).Close




ActiveWorkbook.Sheets("OPT").Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("D:D").Select
    Selection.Copy
    Range("AK1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
        
ActiveWorkbook.Sheets("OPT").Columns("AK:AK").Select
 Selection.TextToColumns Destination:=Range("AK1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    Columns("AK:AK").Select
    Selection.NumberFormat = "m/d/yyyy"
    
    ActiveWorkbook.Sheets("OPT").Columns("AK:AL").Select
    Selection.Copy
    Range("E1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
     Application.CutCopyMode = False
    ActiveWorkbook.Sheets("OPT").Columns("E:E").Select
    Selection.Copy
    Range("D1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("D1").Value = "QC Checklist Submissions Date"
    Range("E1").Value = "QC_Start_Date"
    Range("F1").Value = "QC_Start_Time"
    ActiveWorkbook.Sheets("OPT").Columns("AK:AM").Select
    Selection.ClearContents
    ActiveWorkbook.Sheets("OPT").Columns("G:G").Select
     Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    
    ActiveWorkbook.Sheets("OPT").Columns("J:J").Select
    Selection.Copy
    Range("AK1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
        
ActiveWorkbook.Sheets("OPT").Columns("AK:AK").Select
 Selection.TextToColumns Destination:=Range("AK1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    Columns("AK:AK").Select
    Selection.NumberFormat = "m/d/yyyy"
    ActiveWorkbook.Sheets("OPT").Columns("AK:AL").Select
    Selection.Copy
    Range("G1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
     Application.CutCopyMode = False
     ActiveWorkbook.Sheets("OPT").Columns("AK:AM").Select
    Selection.ClearContents
     Range("G1").Value = "Last_Updated_Date"
    Range("H1").Value = "Last_Updated_Time"
        Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWorkbook.Sheets("OPT").Columns("P:P").Select
    Selection.Copy
    Columns("AC:AC").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("AC1").Value = "Supervisor Backup"
    
     ActiveWorkbook.Sheets("OPT").Columns("P:P").Select
     Selection.Delete Shift:=xlToLeft
    
    ActiveWorkbook.Sheets("OPT").Columns("R:R").Select
    Selection.Insert Shift:=xlToRight
    Columns("S:S").Select
    Selection.Copy
    Columns("R:R").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    ActiveWorkbook.Sheets("OPT").Columns("K:K").Select
    Selection.Copy
    Columns("AB:AB").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("AB1").Value = "Office Backup"
    Range("AA1").Value = "Unique count"
    Range("AA2").Value = 1
    Range("AA3") = "=AA2 + 1"
    Range("AA3").Copy
    Range("AB3").Select
    Selection.End(xlDown).Offset(0, -1).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
      
    Next
copy paste data


Sheets("Data collation").Select
Conso_last = ThisWorkbook.Sheets("Data collation").Range("B" & Rows.count).End(xlUp).Row + 1
Range("B2:AD" & Conso_last).Select
Selection.ClearContents


Lastrow_so = Sheets("Surety").Cells(Sheets("Surety").Rows.count, "A").End(xlUp).Row
Lastrow_lo = Sheets("Lossrun").Cells(Sheets("Lossrun").Rows.count, "A").End(xlUp).Row
Lastrow_op = Sheets("OPT").Cells(Sheets("OPT").Rows.count, "A").End(xlUp).Row




        
 Sheets("Surety").Activate
 Range("A2:AC" & Lastrow_so).Select
Selection.Copy
Sheets("Data collation").Activate
Sheets("Data collation").Range("B2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
 Application.CutCopyMode = False
 
  Sheets("Lossrun").Activate
 Range("A2:AC" & Lastrow_lo).Select
Selection.Copy
Sheets("Data collation").Activate
Sheets("Data collation").Range("B1").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
 Application.CutCopyMode = False
 
 
   Sheets("OPT").Activate
 Range("A2:AC" & Lastrow_op).Select
Selection.Copy
Sheets("Data collation").Activate
Sheets("Data collation").Range("B1").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
 Application.CutCopyMode = False
 
Sheets("Data collation").Columns("P:P").Select
Selection.Copy
Sheets("Data collation").Columns("AG:AG").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False


Range("AG1").Value = "Associate Name back up"


Range("AE2").Select
Selection.Copy
Range("AD1").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp).Offset(1, 0)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False


Range("AF2").Select
Selection.Copy
Range("AE1").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp).Offset(1, 0)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False




Range("AH2").Select
Selection.Copy
Range("AG1").Select
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp).Offset(1, 0)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False




If (Application.WorksheetFunction.CountIf(Columns("AE:AE"), "#N/A") > 0) Then
MsgBox ("Total Missing New office are" & " " & (Application.WorksheetFunction.CountIf(Columns("AE:AE"), "#N/A") & " " & "!" & " " & "Clear [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=NA]#NA[/URL] "))


Exit Sub
End If
If (Application.WorksheetFunction.CountIf(Columns("AE:AE"), 0) > 0) Then
MsgBox MsgBox("Total Missing New office are" & " " & (Application.WorksheetFunction.CountIf(Columns("AE:AE"), 0) & " " & "!" & " " & "Clear [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=NA]#NA[/URL]  for office"))
Exit Sub


End If
If (Application.WorksheetFunction.CountIf(Columns("AE:AE"), "#N/A") = 0) Then Range("AE2:AE100000").Select
Selection.Copy
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False




If (Application.WorksheetFunction.CountIf(Columns("AG:AG"), "#N/A") > 0) Then
MsgBox (Application.WorksheetFunction.CountIf(Columns("AG:AG"), "#N/A") & " " & "are Missing Associate Name Records" & " " & "!" & " " & "Clear [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=NA]#NA[/URL] ")
Exit Sub
End If
If (Application.WorksheetFunction.CountIf(Columns("AG:AG"), 0) > 0) Then
MsgBox (Application.WorksheetFunction.CountIf(Columns("AG:AG"), 0) & " " & "are Missing Associate Name Records") & " " & "!" & " " & "Clear [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=NA]#NA[/URL]  for associates"
Exit Sub


End If


If (Application.WorksheetFunction.CountIf(Columns("AG:AG"), "#N/A") = 0) Then Range("AG2:AG100000").Select
Selection.Copy
Range("P2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False


If (Application.WorksheetFunction.CountIf(Columns("AH:AH"), "#N/A") > 0) Then
MsgBox (Application.WorksheetFunction.CountIf(Columns("AH:AH"), "#N/A") & " " & "are Missing Region Name " & " " & "Clear [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=NA]#NA[/URL] ")
Exit Sub
End If


If (Application.WorksheetFunction.CountIf(Columns("AH:AH"), 0) > 0) Then
MsgBox (Application.WorksheetFunction.CountIf(Columns("AH:AH"), 0) & " " & "are Missing Region Name " & " " & "Clear [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=NA]#NA[/URL]  from Region")
Exit Sub
End If




Range("B1").Select


Sheets("Surety").Visible = False
Sheets("Lossrun").Visible = False
Sheets("OPT").Visible = False


Sheets("Home").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Dear All Members..

Can someone please do...Need in professional coding..this is in recorded form
 
Upvote 0
Hi All,
I need someone expert help to shorten the code Or to write a professional code for this..Big appreciate in advance
 
Upvote 0
Why, and what do you mean by "in professional way"?
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Increasing row before the macro runs again
Replies
1
Views
211
kbk
K
willow1985
  • Solved
VBA Run-time error 91 - Object variable or With block variable not set when trying to refresh data/Sleep
Replies
4
Views
280
willow1985
willow1985
S
  • Question Question
Dynamic Address by VBA
Replies
8
Views
152
MikeVol
MikeVol
S
  • Question Question
Macro Formatting to all WS
Replies
4
Views
315
MARK858
MARK858
C
  • Question Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
429
myall_blues
myall_blues

Forum statistics

Threads
1,223,893
Messages
6,175,244
Members
452,622
Latest member
Laura_PinksBTHFT

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top