Here is my full code Mart
Private Sub CommandButton1_Click()
On Error Resume Next
With Range("B3:B2500")
.Value = .Value
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Remove
End Sub
Sub Remove()
Dim rngDel As Range
Dim A As Long
For A = Range("I" & Rows.Count).End(xlUp).Row To 2 Step -1
With Cells(A, 9)
If .Value Like "*X1*" Or .Value Like "*X2*" Or .Value Like "*X3*" Then
If rngDel Is Nothing Then
Set rngDel = .EntireRow
Else
Set rngDel = Union(rngDel, .EntireRow)
End If
End If
End With
Next A
If Not rngDel Is Nothing Then rngDel.Delete xlShiftUp
Sortdate
End Sub
Sub Sortdate()
Sheet1.Range("P3", "P3000").NumberFormat = "yyyymmdd"
InsertColumn
End Sub
Sub InsertColumn()
Columns("AE:AE").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AE2").Value = "*Company"
sbRangeData
End Sub
Sub sbRangeData()
With Sheets("Sheet1")
Set RngCol = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
End With
LastRow = RngCol.Rows.Count
Range("AE3:AE" & LastRow).Value = "780001"
Amountsort
End Sub
Sub Amountsort()
Range("X3", "X1500").Select
With Selection
Selection.NumberFormat = "General"
.Value = .Value
End With
Converttonumber
End Sub
Sub Converttonumber()
Range("A3:O2500").Select
With Selection
Selection.NumberFormat = "General"
.Value = .Value
End With
FindAndReplace80391
End Sub
Sub FindAndReplace80391()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("A" & i).Value = "80391" Then
Range("B" & i).Value = "10001"
End If
Next i
FindAndReplace130680
End Sub
Sub FindAndReplace130680()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("A" & i).Value = "130680" Then
Range("B" & i).Value = "654001"
End If
Next i
FindAndReplace374747
End Sub
Sub FindAndReplace374747()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("A" & i).Value = "374747" Then
Range("B" & i).Value = "10001"
End If
Next i
FindAndReplace80399
End Sub
Sub FindAndReplace80399()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("A" & i).Value = "80399" Then
Range("B" & i).Value = "464001"
End If
Next i
FindAndReplace97065986
End Sub
Sub FindAndReplace97065986()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("A" & i).Value = "97065986" Then
Range("B" & i).Value = "84001"
End If
Next i
company
End Sub
Sub company()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("*Company", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("A3")
Else
MsgBox "Search Item Not Found!"
Exit Sub
End If
companycode
End Sub
Sub companycode()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Company Code", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("B3")
Else
MsgBox "Search Item Not Found!"
Exit Sub
End If
TradingPartner
End Sub
Sub TradingPartner()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Trading Partner", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("D3")
Else
MsgBox "Search Item Not Found!"
Exit Sub
End If
Reference
End Sub
Sub Reference()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Reference", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("E3")
Else
MsgBox "Search Item Not Found!"
Exit Sub
End If
Assignment
End Sub
Sub Assignment()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Assignment", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("F3")
Else
MsgBox "Search Item Not Found!"
Exit Sub
End If
DocumentNumber
End Sub
Sub DocumentNumber()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Document Number", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("G3")
Else
MsgBox "Search Item Not Found!"
Exit Sub
End If
DocumentType
End Sub
Sub DocumentType()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Document Type", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("H3")
Else
MsgBox "Search Item Not Found!"
Exit Sub
End If
DocumentDate
End Sub
Sub DocumentDate()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Document Date", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("I3")
Else
MsgBox "Search Item Not Found!"
Exit Sub
End If
Account
End Sub
Sub Account()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Account", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("K3")
Else
MsgBox "Search Item Not Found!"
Exit Sub
End If
Amount
End Sub
Sub Amount()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Amount in doc. curr.", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("L3")
Else
MsgBox "Search Item Not Found!"
Exit Sub
End If
Documentcurrency
End Sub
Sub Documentcurrency()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Document currency", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("M3")
Else
MsgBox "Search Item Not Found!"
Exit Sub
End If
change
End Sub
Sub change()
Dim sh As Worksheet
sh.Range("A2").Select
Nextsheet
End Sub
Sub Nextsheet()
ActiveSheet.Next.Activate
End Sub
-------------------------------------------
Once the amount in document currency is formatted to text to number i want the cursor point to go to sheet 1- A2