Eric Penfold
Active Member
- Joined
- Nov 19, 2021
- Messages
- 431
- Office Version
- 365
- Platform
- Windows
- Mobile
Can`t seem to get the VBA to get first 2 Words from a File Name.
VBA Code:
If UCase(wb.Name) Like "Purchase Orders*" Then
.Range("E2" & LRow).Value = Date
.Range("E2" & LRow).NumberFormat = "dd/mm/yyyy"
End If
Sub Format_Cells()
Dim wb As Workbook
Dim ws As Worksheet
Dim LRow As Long, i As Long
Dim DelRng As Range
Dim TxString As String, Result() As String
Dim wc As Integer
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet")
LRow = Cells(Rows.Count, 1).End(xlUp).Row
Set DelRng = ws.Range("A2:E" & LRow)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
DelRng.Cells.UnMerge
With ws
For i = LRow To 1 Step -1
If .Range("A" & i).Value = "" Then
.Range("A" & i).EntireRow.Delete
End If
Next i
For i = 1 To LRow
If IsNumeric(.Cells(i, 6).Value) Then
.Cells(i, 6).Insert Shift:=xlToRight
End If
.Cells(i, 5).Value = .Cells(i, 5).Value & " " & .Cells(i, 6).Value
Next i
.Range("E1").Replace What:="*", _
Replacement:="Due Date", MatchCase:=True
ws.Columns("A").HorizontalAlignment = Excel.Constants.xlCenter
ws.Columns("C").HorizontalAlignment = Excel.Constants.xlCenter
ws.Columns("E").HorizontalAlignment = Excel.Constants.xlCenter
.Columns(9).Delete
.Columns(8).Delete
.Columns(7).Delete
.Columns(6).Delete
If UCase(wb.Name) Like "Purchase Orders*" Then
.Range("E2" & LRow).Value = Date
.Range("E2" & LRow).NumberFormat = "dd/mm/yyyy"
End If
End With
For i = 1 To Cells.SpecialCells(xlLastCell).Rowb
If Cells(i, 1) <> vbNullString Then
If Cells(i, 1) = Cells(i + 1, 1) Then
Cells(i + 1, 1).EntireRow.Delete
i = i - 1
End If
End If
Next i
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub