Following macro code is for copying Excel Invoice Data to Excel Database. Also cleans the specified cells after copying. Its working Perfectly.
But there are some issues that should be solved.
Problem 1: It copies empty cells(""), formula based cells and blank drop-down list.
Problem 2: After copying it cleans formulas too. Formulas must be remain their.
Sub INV()
Dim rng As Range
Dim i As Long
Dim a As Long
Dim rng_dest As Range
Application.ScreenUpdating = False
'Check if invoice # is found on sheet "Invoice data"
i = 1
Do Until Sheets("Invoice data").Range("A" & i).Value = ""
If Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("K4").Value Then
'Ask overwrite invoice #?
If MsgBox("Invoice Already Exist.. Do you want to Overwrite.?", vbYesNo) = vbNo Then
Exit Sub
Else
Exit Do
End If
End If
i = i + 1
Loop
i = 1
Set rng_dest = Sheets("Invoice data").Range("I:N")
'Delete rows if invoice # is found
Do Until Sheets("Invoice data").Range("A" & i).Value = ""
If Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("K4").Value Then
Sheets("Invoice data").Range("A" & i).EntireRow.Delete
i = 1
End If
i = i + 1
Loop
' Find first empty row in columns I:N on sheet Invoice data
Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
i = i + 1
Loop
'Copy range B17:I39 on sheet Invoice
Set rng = Sheets("Invoice").Range("B17:I39")
' Copy rows containing values to sheet Invoice data
For a = 1 To rng.Rows.Count
If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
rng_dest.Rows(i).Value = rng.Rows(a).Value
'Copy Invoice number
Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("K4").Value
'Copy Date
Sheets("Invoice data").Range("B" & i).Value = Sheets("Invoice").Range("K3").Value
'Copy Company name
Sheets("Invoice data").Range("C" & i).Value = Sheets("Invoice").Range("A10").Value
'PO No.
Sheets("Invoice data").Range("D" & i).Value = Sheets("Invoice").Range("K5").Value
'Sales Person
'Sheets("Invoice data").Range("E" & i).Value = Sheets("Invoice").Range("A18").Value
'Shipping Method
Sheets("Invoice data").Range("F" & i).Value = Sheets("Invoice").Range("K7").Value
'Shipping Terms
Sheets("Invoice data").Range("G" & i).Value = Sheets("Invoice").Range("K8").Value
'Payment Term
Sheets("Invoice data").Range("H" & i).Value = Sheets("Invoice").Range("K6").Value
'S&H
Sheets("Invoice data").Range("O" & i).Value = Sheets("Invoice").Range("L44").Value
'Ship To Company Name
Sheets("Invoice data").Range("P" & i).Value = Sheets("Invoice").Range("I10").Value
'Ship To Street Address
Sheets("Invoice data").Range("Q" & i).Value = Sheets("Invoice").Range("I11").Value
'Ship To City State Zip
Sheets("Invoice data").Range("R" & i).Value = Sheets("Invoice").Range("I12").Value
'Ship To Phone
Sheets("Invoice data").Range("S" & i).Value = Sheets("Invoice").Range("J13").Value
'Ship To Contact Person
Sheets("Invoice data").Range("T" & i).Value = Sheets("Invoice").Range("K14").Value
i = i + 1
End If
Next a
MsgBox ("Invoice saved!")
If Worksheets("Invoice").Range("K4") = "100000" Then
Application.DisplayAlerts = False
Worksheets("invoice data").Delete
Application.DisplayAlerts = True
End If
Application.ScreenUpdating = True
'Sheets("Invoice").Range("K4").Value = _
'Sheets("Invoice").Range("K4").Value + 1
Dim sCounter As String
Dim nCounter As Long
sCounter = Sheets("Invoice").Range("K4").Value
nCounter = Mid(sCounter, 4) + 1
If nCounter < 100000 Then
Mid(sCounter, 4) = Format(nCounter, "00000")
Else
sCounter = "Number out of range"
End If
Sheets("Invoice").Range("K4").Value = sCounter
Range("B17:I39").ClearContents
End Sub
Bookmarks