excel vba
6 TopicsPivot table with calculation and auto sort
Hi, I am busy working on a pivot table to calculate 1st, 2nd & 3rd place with scores. But the sorting does not want to work if I add a calculated field. I need to sort the data from largest to smallest and then work out the difference between the highest score and the other player's score. Example:657Views0likes0CommentsMerge cells and autofill
Hello, I'm making a template that calaculate % dissolved of drug during analysis of its content in tablets. The picture above shows analysis of 3 tablets (3 cups) that was sampled on intervals (10 minutes, 15 minutes,.....etc). What I want is a code that automatically create the above cells by just specifying number of intervals and number of cups analyzed. So to apply this on the example above, number of intervals would be 6 and number of cups would be 3. Also under the column diss% I want a code that drag the first equation to the last column. Thanks772Views0likes0CommentsVisual Basic / VB editor in Excel 2019 unavailable
Hi all. I'm having a problem with Excel 2019. I can't open the VB editor at all. It's unavailable or greyed out. To me, this means that there is something wrong with the installation of Office 2019. I havern't had any other problems with any other Office programs as yet as this was just installed. I use VB editor a lot and am now stranded until I can fix this problem. Please help.2.1KViews0likes5CommentsVBA to send the excel from outlook with attachment
Anyone from the forum please review below code and advice corrections. When I click Accepted and send, the email was sent but there is no data in the spreadsheet. Sub Button3_Click() Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = "xyz@hotmail.com" .CC = "" .BCC = "" .Subject = "Approved: Costing Change Request Form" .Body = "I am authorised or have delegation of authority to submit attached costing changes for given staff" .Attachments.Add ActiveWorkbook.FullName End With Response = MsgBox("If you are sure to send an email to HR Service Centre", vbOKCancel + vbCritical, "Exiting Sub") If Response = vbOK Then OutMail.Send MsgBox ("Thank you! Your request is sent to HR service centre. You will soon receive an email with ticket number for reference") ElseIf Response = vbCancel Then MsgBox ("Form is not submitted") End If On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Sub4.3KViews0likes0CommentsVBA for Userform For Expenses
I have this Userform to make the data input easier. Picture 1. After I adapt some vba code Then I run the userform then it goes to Data table. Picture 2. My concern is to make the Userform more interface. I want, before I can submit the data, the total of item price shows, so the user may know how much the expenditure for an item. And I still dont know how to make it. It will be more appreciate if there anybody can make this code simple. This is the vba code: Dim currentrow As Long Private Sub cmbType_Change() End Sub Private Sub cmdGetNext_Click() Dim NameFound As Range fPath = ThisWorkbook.Path & "\" Range("A1").Select ActiveCell.End(xlDown).Select lastrow = ActiveCell.Row currentrow = currentrow + 1 If currentrow = lastrow + 1 Then currentrow = lastrow MsgBox "you have reached the last row!" End If With Cells(currentrow, 1) txtItem.Text = Cells(currentrow, 4).Value Set NameFound = .Find(txtItem.Text) With NameFound On Error Resume Next imgData.Picture = LoadPicture(fPath & "nopic.jpg") imgData.Picture = LoadPicture(fPath & txtItem.Text & ".jpg") End With End With txtItem.Text = Cells(currentrow, 4).Value txtQty.Text = Cells(currentrow, 5).Value txtPrice.Text = Cells(currentrow, 7).Value End Sub Private Sub cmdGetPrev_Click() Dim NameFound As Range fPath = ThisWorkbook.Path & "\" currentrow = currentrow - 1 If currentrow > 1 Then txtItem.Text = Cells(currentrow, 4).Value txtQty.Text = Cells(currentrow, 5).Value txtPrice.Text = Cells(currentrow, 7).Value With Cells(currentrow, 1) txtItem.Text = Cells(currentrow, 4).Value Set NameFound = .Find(txtItem.Text) With NameFound On Error Resume Next imgData.Picture = LoadPicture(fPath & "nopic.jpg") imgData.Picture = LoadPicture(fPath & txtItem.Text & ".jpg") End With End With ElseIf currentrow = 1 Then MsgBox "This is your first record!" currentrow = currentrow + 1 End If End Sub Private Sub cmdSubmit_Click() Range("A1").Select ActiveCell.End(xlDown).Select lastrow = ActiveCell.Row 'MsgBox lastrow Cells(lastrow + 1, 1).Value = cmbDate.Text Cells(lastrow + 1, 2).Value = cmbMonth.Text Cells(lastrow + 1, 3).Value = cmbYears.Text Cells(lastrow + 1, 4).Value = txtItem.Text Cells(lastrow + 1, 5).Value = txtQty.Text Cells(lastrow + 1, 6).Value = cmbUnit.Text Cells(lastrow + 1, 7).Value = txtPrice.Text Cells(lastrow + 1, 9).Value = cmbType.Text Cells(lastrow + 1, 10).Value = cmbSubType.Text Cells(lastrow + 1, 11).Value = cmbSupplier.Text Range("A1").Select cmbUnit = "" txtItem.Text = "" txtQty.Text = "" txtPrice.Text = "" cmbType = "" cmbSubType = "" End Sub Private Sub UserForm_Initialize() currentrow = 1 If currentrow = 1 Then MsgBox " you are now in the header row. Click Next to see the first data!" cmbDate.Text = "" cmbMonth.Text = "" cmbYears = "" txtItem.Text = "" txtQty.Text = "" txtPrice.Text = "" With Me.cmbDate .AddItem "1" .AddItem "2" .AddItem "3" .AddItem "4" .AddItem "5" .AddItem "6" .AddItem "7" .AddItem "8" .AddItem "9" .AddItem "10" .AddItem "11" .AddItem "12" .AddItem "13" .AddItem "14" .AddItem "15" .AddItem "16" .AddItem "17" .AddItem "18" .AddItem "19" .AddItem "20" .AddItem "21" .AddItem "22" .AddItem "23" .AddItem "24" .AddItem "25" .AddItem "26" .AddItem "27" .AddItem "28" .AddItem "29" .AddItem "30" .AddItem "31" End With With Me.cmbMonth .AddItem "1" .AddItem "2" .AddItem "3" .AddItem "4" .AddItem "5" .AddItem "6" .AddItem "7" .AddItem "8" .AddItem "9" .AddItem "10" .AddItem "11" .AddItem "12" End With With Me.cmbYears .AddItem "2017" .AddItem "2018" .AddItem "2019" .AddItem "2020" .AddItem "2021" .AddItem "2022" End With With Me.cmbUnit .AddItem "Kg" .AddItem "pcs" .AddItem "L" .AddItem "buah" .AddItem "can" .AddItem "tray" .AddItem "box" .AddItem "botol" .AddItem "times" .AddItem "lembar" .AddItem "month" .AddItem "tabung" .AddItem "ikat" End With With Me.cmbSubType .AddItem "F&B" .AddItem "INVESTMENT" .AddItem "LABOR" .AddItem "MAINTENANCE" .AddItem "MARKETING" .AddItem "OPERATIONAL" .AddItem "UTILITIES" End With With Me.cmbType .AddItem "AGE.DONATION" .AddItem "AGE. PRINTING O. SUP." .AddItem "AGE.SCURUTY" .AddItem "AGE.TELEPHONE" .AddItem "AGE.TRANSPORT" .AddItem "BEVERAGE" .AddItem "DOE.CLEANING SUPPLIES" .AddItem "DOE.DECORATION" .AddItem "DOE.EXTERMINATING" .AddItem "DOE. PAPER & PLASTICT" .AddItem "DOE.SERVICE WARE" .AddItem "EMPLOYEE BENEFIT" .AddItem "EQUIPMENT" .AddItem "FOOD" .AddItem "LEGALITAS" .AddItem "MARKETING" .AddItem "MKT.DRIVER COMMISION" .AddItem "PRIVATE" .AddItem "RESEARCH" .AddItem "RM. BUILDING IMP." .AddItem "RM.ELECTRICAL" .AddItem "RM.EQUIPMENT" .AddItem "SALARIES" .AddItem "UTI.ELECTRICAL" .AddItem "UTI.LPG" .AddItem "UTI.PETROL" End With With Me.cmbSupplier .AddItem "VEGETABLE HENDRI" .AddItem "JOIN" .AddItem "VEGETABLE ZUL" .AddItem "DROP IN" .AddItem "AMAT" .AddItem "BANYU URIP" .AddItem "JASMINE" .AddItem "RAJA KENTANG" .AddItem "H.JENUN" .AddItem "KUBUS" .AddItem "Langgeng Makmur Kencana" .AddItem "PT. Inti Sari Buana" .AddItem "LOTUS" .AddItem "COCA COLA COMPANY" .AddItem "CV 88" .AddItem "ALFAMART" .AddItem "DEDY 'S" .AddItem "WINE STATION" .AddItem "ACE HARDWARE" .AddItem "GAJAH GOTRA BALI" .AddItem "OJEK" .AddItem "FLORIST" .AddItem "INDOMARET" .AddItem "MDX" .AddItem "Natural Computer" .AddItem "NUSA FISHINDO" .AddItem "PAID" .AddItem "PANDAN" .AddItem "PDAM" .AddItem "PT. LOMBOK MITRA UTAMA" .AddItem "SANDUBAYA SERVICE" .AddItem "SASAK JAYA" .AddItem "SHOPEE" .AddItem "SLCA" .AddItem "SMART CLUB" .AddItem "Surya Laut Sentosa" .AddItem "TRI PUTRI" .AddItem "UD.BAROKAH" .AddItem "NATURA ENERGY" End With End If End Sub Thank you in advance, Ridwan2.7KViews0likes0Comments