nareshmedarmatila
New Member
- Joined
- Apr 1, 2020
- Messages
- 17
- Office Version
- 365
- 2019
- Platform
- Windows
I need a help
Is there any chance we can reduce the code ?
FYI: The code is working fine.
Is there any chance we can reduce the code ?
VBA Code:
Sub ref_no()
'
' Macro for Reference Number
If ActiveSheet.Name = "Sheet1" Then
MsgBox "Cannot Run macro In This sheet. Try in Another Sheet"
Exit Sub
End If
result = MsgBox("Replacing Existing Data with Reference Number", vbOKCancel + vbQuestion, QC_TOOL)
If result = vbCancel Then
Exit Sub
Else
Cells.Select
Selection.ClearContents
Cells.Select
Selection.Cut
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Sheets("Sheet1").Range("A:A").Copy Range("A1")
With Range("A:A")
.EntireColumn.AutoFit
Sheets("Sheet1").Range("B:B").Copy Range("B1")
With Range("B:B")
.EntireColumn.AutoFit
Sheets("Sheet1").Range("D:D").Copy Range("C1")
With Range("C:C")
.EntireColumn.AutoFit
.TextToColumns Destination:=Range("E1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(3, 2), Array(8, 2), Array(13, 2), Array(17, 2), _
Array(23, 2), Array(26, 2), Array(31, 2), Array(35, 2), Array(38, 2), Array(43, 2)), _
TrailingMinusNumbers:=True
Range("A1:O1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Selection.Font.Bold = True
Rows("1:1").Select
Selection.AutoFilter
Cells.Select
Cells.EntireColumn.AutoFit
Range("F2").Select
End With
End With
End With
End If
End Sub
FYI: The code is working fine.