The table that i generate with VBA didn't match with my data sheet

Hi,

I face a problem with the output of my VBA. The output suppose to be the same with my excel sheet, but the outcome was not what i expected.

The outcome is suppose to be like this in email.

material.PNG

But my the outcome is like this

Material 2.PNG

And here is my code

[/HTML]Sub Email()

Dim OutApp As Object
Dim OutMail As Object
Dim strBody As String
Dim rng As Range
Dim cell As Range
Dim tbl As String
Dim i As Integer

Set rng = Nothing
On Error Resume Next
Set rng = Sheets("AUTO-BUY").Range("A4:F412").SpecialCells(xlCellTypeVisible)

If rng Is Nothing Then
MsgBox "No data to send to email email."
Exit Sub
End If

tbl = "<table style='border-collapse: collapse; border: 1px solid black;'>"
tbl = tbl & "<tr><th style='border: 1px solid black; padding: 5px;'>Nama Part</th><th style='border: 1px solid black; padding: 5px;'>Spesifikasi</th><th style='border: 1px solid black; padding: 5px;'>Nomor Material Code</th><th style='border: 1px solid black; padding: 5px;'>Status</th><th style='border: 1px solid black; padding: 5px;'>Jumlah yang Dibeli</th><th style='border: 1px solid black; padding: 5px;'>Remarks</th></tr>"

For Each cell In rng
If cell.Value <> "" Then
If i Mod 2 = 0 Then
tbl = tbl & "<tr style='background-color: #F2F2F2;'>"
Else
tbl = tbl & "<td>"
End If
tbl = tbl & "<td style='border: 1px solid black; padding: 5px;'>" & cell.Offset(0, 0).Value & "</td>"
tbl = tbl & "<td style='border: 1px solid black; padding: 5px;'>" & cell.Offset(0, 1).Value & "</td>"
tbl = tbl & "<td style='border: 1px solid black; padding: 5px;'>" & cell.Offset(0, 2).Value & "</td>"
tbl = tbl & "<td style='border: 1px solid black; padding: 5px;'>" & cell.Offset(0, 3).Value & "</td>"
tbl = tbl & "<td style='border: 1px solid black; padding: 5px;'>" & cell.Offset(0, 4).Value & "</td>"
tbl = tbl & "<td style='border: 1px solid black; padding: 5px;'>" & cell.Offset(0, 5).Value & "</td>"
tbl = tbl & "</td>"
i = i + 1
End If
Next cell
tbl = tbl & "</table>"

If i = 0 Then
MsgBox "No data to send to email."
Exit Sub
End If

strBody = "Daftar Barang dengan Stok Kuning dan Merah: " & vbCrLf & vbCrLf
strBody = strBody & tbl

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = Range("I3").Value
.CC = ""
.BCC = ""
.Subject = "Daftar Barang dengan Stok Kuning dan Merah"
.HTMLBody = strBody
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Which line of my code is wrong?

Try it

Please Login or Register  to view this content.

Artik

Thanks
this work perfectly