VBA issue, future steps, break prior.

S

shophoney

Active Member
Joined
Jun 16, 2014
Messages
286
Hi, I seem to be having an issue with the order of my VBA code.

When I enter the RETAIL and COST, TOTAL COST, LANDED and MARGIN disappear.

My code may not be the best, or clean.

I alsohave a picture of the USERFORM below.

Thanks for helping!

Private Sub UserForm_Initialize()

With Application
.WindowState = xlMaximized
'Zoom = Int(.Width / Me.Width * 100)
'Width = .Width
'Height = .Height
End With

'GetName = Environ("UserName")
txtComputerName = Environ("COMPUTERNAME")

Call Refresh_ListBox1

End Sub
Sub Refresh_ListBox1()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("OrderData")
Dim last_Row As Long
last_Row = Application.WorksheetFunction.CountA(sh.Range("A:A"))

With Me.ListBox1
.ColumnHeads = True
.ColumnCount = 26
.ColumnWidths = "0,0,0,0,200,60,90,60,60,50,50,50,50,0,0,0,0,50,80,60,50,70,60,60,60,150,60"
.RowSource = "OrderData!A2:AF" & last_Row
End With

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Me.txtID.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
Me.cboPO_NO.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
Me.txtBO_PO.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 2)
Me.cboBOUGHT_FROM.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 3)
Me.cboVENDOR.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 4)
Me.txtMODEL.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 6)
Me.txtSTART_DATE.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 7)
Me.cboCANCEL_DATE.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 8)
Me.cboCLASS.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 9)
Me.cboSUBCLASS.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 10)
Me.cboSEASON.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 11)
Me.cboCOLOUR.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 12)
Me.cboTREND1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 13)
Me.cboTREND2.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 14)
Me.cboTREND3.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 15)
Me.cboTREND4.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 16)
Me.txtUNITS.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 17)
Me.txtTOTAL_COST.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 18)
Me.txtCOST.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 19)
Me.txtDUTY.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 20)
Me.txtEXCHANGE.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 21)
Me.txtLANDED.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 22)
Me.txtRETAIL.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 23)
Me.txtMARGIN.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 24)
Me.txtNOTE.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 25)
Me.cboPAYMENT_STATUS.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 26)
Me.cboRUN.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 31)

On Error Resume Next
img_Photo.Picture = LoadPicture("D:\Dropbox\Shared_Files\Images\" & Me.txtVENDOR_NO.Value & " - " & Me.txtMODEL.Value & " - " & Me.cboCOLOUR.Value & ".jpg")
On Error Resume Next
img_Photo_2.Picture = LoadPicture("D:\Dropbox\Shared_Files\Images\" & Me.txtVENDOR_NO.Value & " - " & Me.txtMODEL.Value & " - " & Me.cboCOLOUR.Value & " - 2" & ".jpg")
On Error Resume Next
img_Photo_3.Picture = LoadPicture("D:\Dropbox\Shared_Files\Images\" & Me.txtVENDOR_NO.Value & " - " & Me.txtMODEL.Value & " - " & Me.cboCOLOUR.Value & " - 3" & ".jpg")

On Error GoTo 0
Exit Sub
'if error occurs then show me exactly where the error occurs
cmdAdd_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAdd_Click of Form OrderEntry"

End Sub

Private Sub cmdAdd_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("OrderData")
Dim last_Row As Long
last_Row = Application.WorksheetFunction.CountA(sh.Range("A:A"))

'Validations--------------------------------------
If Me.cboVENDOR.Value = "" Then
MsgBox "Please enter a Vendor", vbCritical
Exit Sub
End If

sh.Range("A" & last_Row + 1).Value = "=row()-1"
sh.Range("B" & last_Row + 1).Value = Me.cboPO_NO.Value
sh.Range("C" & last_Row + 1).Value = Me.txtBO_PO.Value
sh.Range("D" & last_Row + 1).Value = Me.cboBOUGHT_FROM.Value
sh.Range("E" & last_Row + 1).Value = Me.cboVENDOR.Value
sh.Range("F" & last_Row + 1).Value = Me.txtVENDOR_NO.Value
sh.Range("G" & last_Row + 1).Value = Me.txtMODEL.Value
sh.Range("H" & last_Row + 1).Value = Me.txtSTART_DATE.Value
sh.Range("I" & last_Row + 1).Value = Me.cboCANCEL_DATE.Value
sh.Range("J" & last_Row + 1).Value = Me.cboCLASS.Value
sh.Range("K" & last_Row + 1).Value = Me.cboSUBCLASS.Value
sh.Range("L" & last_Row + 1).Value = Me.cboSEASON.Value
sh.Range("M" & last_Row + 1).Value = Me.cboCOLOUR.Value
sh.Range("N" & last_Row + 1).Value = Me.cboTREND1.Value
sh.Range("O" & last_Row + 1).Value = Me.cboTREND2.Value
sh.Range("P" & last_Row + 1).Value = Me.cboTREND3.Value
sh.Range("Q" & last_Row + 1).Value = Me.cboTREND4.Value
sh.Range("R" & last_Row + 1).Value = Me.txtUNITS.Value
sh.Range("S" & last_Row + 1).Value = Me.txtTOTAL_COST.Value
sh.Range("T" & last_Row + 1).Value = Me.txtCOST.Value
sh.Range("U" & last_Row + 1).Value = Me.txtDUTY.Value
sh.Range("V" & last_Row + 1).Value = Me.txtEXCHANGE.Value
sh.Range("W" & last_Row + 1).Value = Me.txtLANDED.Value
sh.Range("X" & last_Row + 1).Value = Me.txtRETAIL.Value
sh.Range("Y" & last_Row + 1).Value = Me.txtMARGIN.Value
sh.Range("Z" & last_Row + 1).Value = Me.txtNOTE.Value
sh.Range("AA" & last_Row + 1).Value = Me.cboPAYMENT_STATUS.Value
sh.Range("AB" & last_Row + 1).Value = txtComputerName.Value
sh.Range("AC" & last_Row + 1).Value = Format(Now(), "MM/DD/YY")
sh.Range("AD" & last_Row + 1).Value = Me.txtVENDOR_NO.Value & " - " & Me.txtMODEL.Value & " - " & Me.cboCOLOUR.Value
sh.Range("AE" & last_Row + 1).Value = Me.txtVENDOR_NO.Value & " - " & Me.txtMODEL.Value
sh.Range("AF" & last_Row + 1).Value = Me.cboRUN.Value

Call img_Add_Click
Call img_Add_2_Click
Call img_Add_3_Click
Call cmdClear_Click
Call Refresh_ListBox1

ThisWorkbook.Save

Call MsgBox("A new Order has been added", vbInformation, "Add Order")

On Error GoTo 0
Exit Sub
'if error occurs then show me exactly where the error occurs
cmdAdd_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAdd_Click of Form OrderEntry"

End Sub
Private Sub cmdEdit_Click()

If Me.txtID.Value = "" Then
MsgBox "Select an Order to Update"
Exit Sub
End If

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("OrderData")
Dim Selected_Row As Long
Selected_Row = Application.WorksheetFunction.Match(CLng(Me.txtID.Value), sh.Range("A:A"), 0)

'Validations--------------------------------------
''If Me.cboVENDOR.Value = "" Then
'MsgBox "Please enter a Vendor", vbCritical
'Exit Sub
'End If

sh.Range("B" & Selected_Row).Value = Me.cboPO_NO.Value
sh.Range("C" & Selected_Row).Value = Me.txtBO_PO.Value
sh.Range("D" & Selected_Row).Value = Me.cboBOUGHT_FROM.Value
sh.Range("E" & Selected_Row).Value = Me.cboVENDOR.Value
sh.Range("F" & Selected_Row).Value = Me.txtVENDOR_NO.Value
sh.Range("G" & Selected_Row).Value = Me.txtMODEL.Value
sh.Range("H" & Selected_Row).Value = Me.txtSTART_DATE.Value
sh.Range("I" & Selected_Row).Value = Me.cboCANCEL_DATE.Value
sh.Range("J" & Selected_Row).Value = Me.cboCLASS.Value
sh.Range("K" & Selected_Row).Value = Me.cboSUBCLASS.Value
sh.Range("L" & Selected_Row).Value = Me.cboSEASON.Value
sh.Range("M" & Selected_Row).Value = Me.cboCOLOUR.Value
sh.Range("N" & Selected_Row).Value = Me.cboTREND1.Value
sh.Range("O" & Selected_Row).Value = Me.cboTREND2.Value
sh.Range("P" & Selected_Row).Value = Me.cboTREND3.Value
sh.Range("Q" & Selected_Row).Value = Me.cboTREND4.Value
sh.Range("R" & Selected_Row).Value = Me.txtUNITS.Value
sh.Range("S" & Selected_Row).Value = Me.txtTOTAL_COST.Value
sh.Range("T" & Selected_Row).Value = Me.txtCOST.Value
sh.Range("U" & Selected_Row).Value = Me.txtDUTY.Value
sh.Range("V" & Selected_Row).Value = Me.txtEXCHANGE.Value
sh.Range("W" & Selected_Row).Value = Me.txtLANDED.Value
sh.Range("X" & Selected_Row).Value = Me.txtRETAIL.Value
sh.Range("Y" & Selected_Row).Value = Me.txtMARGIN.Value
sh.Range("Z" & Selected_Row).Value = Me.txtNOTE.Value
sh.Range("AA" & Selected_Row).Value = Me.cboPAYMENT_STATUS.Value
sh.Range("AB" & Selected_Row).Value = txtComputerName.Value
sh.Range("AC" & Selected_Row).Value = Format(Now(), "MM/DD/YY")
sh.Range("AD" & Selected_Row).Value = Me.txtVENDOR_NO.Value & " - " & Me.txtMODEL.Value & " - " & Me.cboCOLOUR.Value
sh.Range("AE" & Selected_Row).Value = Me.txtVENDOR_NO.Value & " - " & Me.txtMODEL.Value
sh.Range("AF" & Selected_Row).Value = Me.cboRUN.Value

Call Refresh_ListBox1
''Call img_Add_Click
''Call img_Add_2_Click
''Call img_Add_3_Click

''ThisWorkbook.Save

''Call MsgBox("A new Order has been added", vbInformation, "Add Order")


End Sub
Private Sub cmdDelete_Click()

If Me.txtID.Value = "" Then
MsgBox "Select an Order to Delete"
Exit Sub
End If

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("OrderData")
Dim Selected_Row As Long
Selected_Row = Application.WorksheetFunction.Match(CLng(Me.txtID.Value), sh.Range("A:A"), 0)
'---------------------------------
sh.Range("A" & Selected_Row).EntireRow.Delete
Call Refresh_ListBox1
End Sub
Private Sub cmdClear_Click()

Me.cboPO_NO.Value = ""
Me.txtBO_PO.Value = ""
Me.cboBOUGHT_FROM.Value = ""
Me.cboVENDOR.Value = ""
Me.txtMODEL.Value = ""
Me.txtSTART_DATE.Value = ""
Me.cboCANCEL_DATE.Value = ""
Me.cboCLASS.Value = ""
Me.cboSUBCLASS.Value = ""
Me.cboSEASON.Value = ""
Me.cboCOLOUR.Value = ""
Me.cboTREND1.Value = ""
Me.cboTREND2.Value = ""
Me.cboTREND3.Value = ""
Me.cboTREND4.Value = ""
Me.txtUNITS.Value = ""
Me.txtCOST.Value = ""
Me.txtTOTAL_COST.Value = ""
Me.txtDUTY.Value = ""
Me.txtEXCHANGE.Value = ""
Me.txtLANDED.Value = ""
Me.txtRETAIL.Value = ""
Me.txtNOTE.Value = ""
Me.txtMARGIN.Value = ""
Me.txtNOTE.Value = ""
Me.cboPAYMENT_STATUS.Value = ""
Me.cboRUN.Value = ""
'Me.img_Photo.Value = ""

End Sub
Private Sub txtUNITS_Change()
Call GetLANDED_COST
Call GetTOTAL_COST
End Sub
Private Sub txtCOST_Change()
If txtCOST.Value <> "" And Not IsNumeric(txtCOST) Then
MsgBox "Please enter Numbers only"
End If
'txtCOST = Format(txtCOST, "Currency")
Dim DUTY As Double
txtDUTY = Format(0.18, "##%")

Dim EXCHANGE As Double
txtEXCHANGE = Format(0.3, "##%")

Call GetLANDED_COST
Call GetTOTAL_COST
End Sub

Private Sub txtDUTY_Change()
Call GetLANDED_COST
Call GetTOTAL_COST
End Sub
Sub GetTOTAL_COST()
txtTOTAL_COST = Format(Val(txtCOST.Value) * (Val(txtUNITS.Value)), "Currency")
End Sub
Sub GetLANDED_COST()
'txtLANDED = Format(Val(txtCOST.Value) + (Val(txtCOST.Value) * (Val(txtDUTY.Value) / 100)), "Currency")
txtLANDED = Format(Val(txtCOST.Value) + (Val(txtCOST.Value) * (Val(txtDUTY.Value) / 100) + Val(txtCOST.Value) * (Val(txtEXCHANGE.Value) / 100)), "Currency")
End Sub
Sub GetMARGIN()
On Error Resume Next
txtMARGIN = Format(1 - (Val(txtCOST.Value) / Val(txtRETAIL.Value)), "##%")
End Sub
Private Sub txtRETAIL_Change()
Call GetLANDED_COST
Call GetTOTAL_COST
End Sub

Private Sub img_Browse_Click()

Dim img As String
img = Application.GetOpenFilename(filefilter:="Jpeg images,*.jpg", Title:="Please select an image")

If Dir(img) <> "" Then
Me.txt_Image_URL_1.Value = img
Me.img_Photo.Picture = LoadPicture(img)
End If

End Sub
Private Sub img_Browse_2_Click()

Dim img_2 As String
img_2 = Application.GetOpenFilename(filefilter:="Jpeg images,*.jpg", Title:="Please select an image")

If Dir(img_2) <> "" Then
Me.txt_Image_URL_2.Value = img_2
Me.img_Photo_2.Picture = LoadPicture(img_2)
End If

End Sub
Private Sub img_Browse_3_Click()

Dim img_3 As String
img_3 = Application.GetOpenFilename(filefilter:="Jpeg images,*.jpg", Title:="Please select an image")

If Dir(img_3) <> "" Then
Me.txt_Image_URL_3.Value = img_3
Me.img_Photo_3.Picture = LoadPicture(img_3)
End If

End Sub
Private Sub img_Add_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("OrderData")

Dim iRow As Long

iRow = Application.WorksheetFunction.CountA(sh.Range("B:B")) + 1

'''''''''''' Add Image''''''''''''
Dim img_name As String
If Dir(ThisWorkbook.Path & Application.PathSeparator & "Images", vbDirectory) = "" Then
MkDir (ThisWorkbook.Path & Application.PathSeparator & "Images")
End If

img_name = ThisWorkbook.Path & Application.PathSeparator & "Images" & Application.PathSeparator & _
Me.txtVENDOR_NO.Value & " - " & Me.txtMODEL.Value & " - " & Me.cboCOLOUR.Value & ".jpg"
On Error Resume Next
FileCopy Me.txt_Image_URL_1.Value, img_name
sh.Range("AG" & iRow).Value = img_name

Dim img_name_CLASS_SALES As String
If Dir(ThisWorkbook.Path & Application.PathSeparator & "Products", vbDirectory) = "" Then
MkDir (ThisWorkbook.Path & Application.PathSeparator & "Products")
End If

img_name_CLASS_SALES = ThisWorkbook.Path & Application.PathSeparator & "Products" & Application.PathSeparator & _
Me.txtVENDOR_NO.Value & " - " & Me.txtMODEL.Value & ".jpg"
FileCopy Me.txt_Image_URL_1.Value, img_name_CLASS_SALES

''''''''''''''''''''''''''''''''''''

'''sh.Protect ""

MsgBox "Data has been added!!!"
''Call Reset

End Sub
Private Sub img_Add_2_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("OrderData")

Dim iRow As Long

iRow = Application.WorksheetFunction.CountA(sh.Range("B:B")) + 1

Dim img_name_2 As String
If Dir(ThisWorkbook.Path & Application.PathSeparator & "Images", vbDirectory) = "" Then
MkDir (ThisWorkbook.Path & Application.PathSeparator & "Images")
End If

img_name_2 = ThisWorkbook.Path & Application.PathSeparator & "Images" & Application.PathSeparator & _
Me.txtVENDOR_NO.Value & " - " & Me.txtMODEL.Value & " - " & Me.cboCOLOUR.Value & " - 2" & ".jpg"
On Error Resume Next
FileCopy Me.txt_Image_URL_2.Value, img_name_2

End Sub
Private Sub img_Add_3_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("OrderData")

Dim iRow As Long

iRow = Application.WorksheetFunction.CountA(sh.Range("B:B")) + 1

Dim img_name_3 As String
If Dir(ThisWorkbook.Path & Application.PathSeparator & "Images", vbDirectory) = "" Then
MkDir (ThisWorkbook.Path & Application.PathSeparator & "Images")
End If

img_name_3 = ThisWorkbook.Path & Application.PathSeparator & "Images" & Application.PathSeparator & _
Me.txtVENDOR_NO.Value & " - " & Me.txtMODEL.Value & " - " & Me.cboCOLOUR.Value & " - 3" & ".jpg"
On Error Resume Next
FileCopy Me.txt_Image_URL_3.Value, img_name_3

End Sub


1629501458900.png
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Sort by date Sort by votes
You apply some formatting to the numbers, maybe it is causing the issue. I can't see anything in the change events that clear the textboxes.

Since you use Val to change text to number, are you using any thousands seperator? Only decimal seperators that are a period are allowed per MS documentation.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
ListBox Click to textbox & delete row
Replies
0
Views
592
pure vito
P
I
  • Question Question
Filter Status Using Checkbox
Replies
1
Views
193
iggyboy29
I
I
  • Locked
  • Question Question
Auto Filter in Excel
Replies
1
Views
185
Fluff
Fluff
P
  • Question Question
Putting data into ListBox1 from UserForm6 to Userform1 listbox
Replies
5
Views
476
dmt32
D
SemperFi
  • Solved
VBA Form TextBox needs formatting
Replies
1
Views
532
SemperFi
SemperFi

Forum statistics

Threads
1,223,246
Messages
6,170,996
Members
452,373
Latest member
TimReeks

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top