Scribd
Upload
43 views2 pages

Macro Filter Numbers - Ullage Table

The document contains VBA code with 7 sub procedures that consolidate data on a worksheet. The sub procedures: 1) filter out non-numeric values in a column and delete rows; 2) delete certain columns; 3) fill a column with ullage values; 4) convert text to numbers; 5) combine data from multiple columns into one column; 6) sort and format a column; and 7) set the row height.

Uploaded by

anilks3
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
43 views2 pages

Macro Filter Numbers - Ullage Table

The document contains VBA code with 7 sub procedures that consolidate data on a worksheet. The sub procedures: 1) filter out non-numeric values in a column and delete rows; 2) delete certain columns; 3) fill a column with ullage values; 4) convert text to numbers; 5) combine data from multiple columns into one column; 6) sort and format a column; and 7) set the row height.

Uploaded by

anilks3
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 2

Sub ConsolidateData()

FilterTxtValues
CombineColumns1
ConvertTextToNumbers
SortFormatColumn
Fill_Ullage_ColumnA
SetRowHeight

End Sub
Sub FilterTxtValues()
'
' Finds any text values in first column cells and deletes entire row if any text is
found

Dim i As Long
Dim lastRow As Long

lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For i = lastRow To 1 Step -1


If Not IsNumeric(Cells(i, 1).Value) Then
Rows(i).Delete
End If
Next i

Range("C:C,E:E,G:G").Select ' Select ullage number column


Selection.Delete Shift:=xlToLeft ' Deletes the selection
Range("$B$2:$E$650").Select

End Sub
Sub Fill_Ullage_ColumnA()
Dim i As Double
For i = 0 To 21 Step 0.01
Range("A" & Round(i * 100) + 2).Value = i
Next i
End Sub

Sub ConvertTextToNumbers()
Dim cell As Range
Range("$A$2:$B$2380").Select
For Each cell In Selection.Cells
If IsNumeric(cell.Value) Then
cell.Value = Val(cell.Value)
End If
Next cell

End Sub

Sub CombineColumns1()
'updateby Extendoffice
Dim xRng As Range
Dim i As Integer
Dim xLastRow As Integer
Dim xTxt As String
On Error Resume Next
xTxt = Application.ActiveWindow.RangeSelection.Address
Set xRng = Application.InputBox("please select the data range", "MyVBA",
xTxt, , , , , 8)
If xRng Is Nothing Then Exit Sub
xLastRow = xRng.Columns(1).Rows.Count + 1
For i = 2 To xRng.Columns.Count
Range(xRng.Cells(1, i), xRng.Cells(xRng.Columns(i).Rows.Count, i)).Cut
ActiveSheet.Paste Destination:=xRng.Cells(xLastRow, 1)
xLastRow = xLastRow + xRng.Columns(i).Rows.Count
Next
End Sub

Sub SortFormatColumn()

ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add2 Key:=Range("B:B"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("B:B")
.Header = xlYes
.Apply
End With
' Below lines Format columns A and B to 2 decimal places with Courier New font,
size 12, centered
Columns("A:B").NumberFormat = "0.00"
Columns("A:B").Font.Name = "Courier New"
Columns("A:B").Font.Size = 12
Columns("A:B").Font.FontStyle = "Regular"
Columns("A:B").HorizontalAlignment = xlCenter

' Selects rows with spurious values at the end of the table
Range("A2102:B2380").Select
Selection.ClearContents

End Sub

Sub SetRowHeight()
Dim rng As Range
Set rng = Range("A1:A2200") ' set the range to which the row height will be
applied

rng.RowHeight = 16 ' set the row height to 16

End Sub

You might also like