Using VBA, I'm making a sub that should, in some instances, output maybe hundreds of strings. Can I make a long MsgBox where all of those strings are occupying a different paragraph each? In my workbook, the worksheets have tables with the code of a product in the first column and the stock in the eighth (last), I have made the function AverageStock that returns the average stock of a certain product code in a worksheet.
Sub test()
Dim product_code as String
Dim LRow as Integer
Dim k as Integer
LRow = Range("A3").End(xlDown).Row
product_code = InputBox("Product Code")
For k = 3 To LRow
If Cells(k, 8) > AverageStock(product_code) Then
I only have this till now, any help/suggestions?
MsgBox will only contain text and a title:
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/msgbox-function
The option you have is to create a custom UserForm.
Related
I'm an electrical contractor and I made a worksheet to help me bid projects.
Say I'm bidding on wiring a new house. I have broken down each task "outlet"/"Switch" to materials and labor needed for each task. Those materials are then multiplied by the quantity needed and populate 3 different tables automatically.
Here is the process: (24 outlets are needed for this job)
"Bid Cut Sheet" Sheet where quantities of specific tasks are entered.
"Job List" Tasks are broken down into materials needed for that task, multiplied by the quantity entered in "Bid Cut Sheet"
"Material Sheet" Total of all material needed for the job in 3 different tables/stages of the project
What I am trying to do is populate rows in EACH table where materials are needed. Essentially consolidate the data in EACH table by eliminating with quantities of 0 and ADDING rows with quantities >0 and fill down rows with material needed: updating every time data is entered in the "Bid Cut Sheet"
This code eliminates values of 0 after I run the code, but does not update data entered in the "bid cut sheet" after I run the code. Also, I would like this to be imbedded in the workbook so I dont have to run the code each time I use the workbook.
Sub DeleteRowsBasedonCellValue()
'Declare Variables
Dim i As Long, LastRow As Long, Row As Variant
Dim listObj As ListObject
Dim tblNames As Variant, tblName As Variant
Dim colNames As Variant, colName As Variant
'Names of tables
tblNames = Array("Rough_Material", "Trim_Material", "Service_Material")
colNames = Array("Rough", "Trim", "Service")
'Loop Through Tables
For i = LBound(tblNames) To UBound(tblNames)
tblName = tblNames(i)
colName = colNames(i)
Set listObj = ThisWorkbook.Worksheets("MaterialSheet").ListObjects(tblName)
'Define First and Last Rows
LastRow = listObj.ListRows.Count
'Loop Through Rows (Bottom to Top)
For Row = LastRow To 1 Step -1
With listObj.ListRows(Row)
If Intersect(.Range, _
listObj.ListColumns(colName).Range).Value = 0 Then
.Delete
End If
End With
Next Row
Next i
End Sub
This is what it looks like after running the code, it works one time but does not update.
If I understand your question correctly, what you are looking for is something like this:
Sub DeleteRowsBasedonCellValue()
'Declare Variables
Dim LastRow As Long, FirstRow As Long
Dim Row As Long
Dim columns As Variant, column As Variant
columns = Array("A", "D", "G")
With ThisWorkbook.Worksheets("Sheet1") '<- type the name of the Worksheet here
'Define First and Last Rows
FirstRow = 1
LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
'Loop Through Columns
For Each column In columns
'Loop Through Rows (Bottom to Top)
For Row = LastRow To FirstRow Step -1
If .Range(column & Row).Value = 0 Then
.Range(column & Row).Resize(1, 2).Delete xlShiftUp
End If
Next Row
Next column
End With
End Sub
Test it out and see if this does what you want.
Alternatively, it might be wiser to be more explicit and make the code more flexible. If your tables are actually formatted as tables, you can also loop over these so-called ListObjects. That way, if you insert columns/rows in the future, the code won't break.
To do this, you could use code like this:
Sub DeleteRowsBasedonCellValue()
'Declare Variables
Dim i As Long, LastRow As Long, Row As Variant
Dim listObj As ListObject
Dim tblNames As Variant, tblName As Variant
Dim colNames As Variant, colName As Variant
'The names of your tables
tblNames = Array("Rough_Materials", "Trim_Materials", "Service_Materials")
colNames = Array("quantity_rough", "quantity_trim", "quantity_service")
'The name of the column the criterion is applied to inside each table
'Loop Through Tables
For i = LBound(tblNames) To UBound(tblNames)
tblName = tblNames(i)
colName = colNames(i)
Set listObj = ThisWorkbook.Worksheets("Sheet1").ListObjects(tblName)
'Define First and Last Rows '^- the name of the Worksheet
LastRow = listObj.ListRows.Count
'Loop Through Rows (Bottom to Top)
For Row = LastRow To 1 Step -1
With listObj.ListRows(Row)
If Intersect(.Range, _
listObj.ListColumns(colName).Range).Value = 0 Then
.Delete
End If
End With
Next Row
Next i
End Sub
Edit in response to your comment:
Make sure your table is actually formatted as a table and has been given the right name! You can also change the table names in your code to your liking in the line tblNames = Array("Rough_Materials", "Trim_Materials", "Service_Materials"). Also, the column names have to be correct/you should adapt them in the code: colNames = Array("quantity_rough", "quantity_trim", "quantity_service")
I have been searching for almost 2 days to find an answer to this and it is driving me insane. I am very new to VBA so I don't have any code to share, just been trying out things I find on other sites and youtube. I have a technician sign in sheet that I have been working on and these are the steps I need done:
select your name from the "Metrology Tech." combobox on the 'Metrology Tech log-in' sheet
VBA searches thru column H in 'metrology tracker' to find all matching names
The lot numbers from column E in 'metrology tracker' sheet are put into the "Lot Number" combobox if the value in column M in 'metrology tracker' sheet is equal to "Pend."
I've tried this Create Dependent Combo Boxes on a Userform - Excel VBA and it did not work it just returned all the values of the column I need and all the other articles and videos were pretty much the same thing.
one thing I should note is that most of the values in the metrology tracker are referenced from another file so the lot numbers are equal to a cell value in another file.
Edit:
Ive tried this even though I knew it wasn't going to work
Private Sub cboTech_change()
Select Case cboTech.Value
Case Is = "employee 1"
cboLotNum.RowSource = "LotNumber"
Case Is = "employee 2"
cboLotNum.RowSource = "LotNumber"
Case Is = "employee 3"
cboLotNum.RowSource = "LotNumber"
End Select
End Sub
and also tried this, but kept on gettting a "run-time error '424' object required"
Sub FndLot()
Dim idx As Long
Dim lngRow As Long
idx = TechBox.ListIndex
If idx <> -1 Then
lngRow = TechBox.ListIndex
Worksheets("Metrology Tracker").Range("E" & lngRow).Value = LotNum.Value
End If
End Sub
Not too sure what you want but this should get you started.
Private Sub cboTech_Change()
Dim sName As String
sName = cboTech.Text
cboLotNum.Clear
Dim ws As Worksheet, lastrow As Long, i As Long
Set ws = Sheets("metrology tracker")
With ws
lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
For i = 1 To lastrow
If .Cells(i, "H") = sName And .Cells(i, "M") = "pend" Then
cboLotNum.AddItem .Cells(i, "E")
End If
Next
End With
End Sub
I need advise from the pros here. i basically have 0 knowledge on vba excel.
I recently had designed a UserForm and i took advantage of online code.
First of all, i have this UserForm allowing me to key in a part number and search from this sheet call "MASTER" in "pntxt" textbox and it will return a list of values to text box 2 to 10. This part of the code is already working and running well.
To further enhance it, i would like to have the "update" button in this user form.
For example, one of the text box is name as "pricetxt" after calling out using values from "pntxt", as a user, i need to amend the "pricetxt" textbox. after which, it will update back my excel sheet.
I had tried the following code and it's not working.
Private Sub update2_Click()
Dim lastRow As Variant
Dim partno As Variant
Dim rowSelect As Variant
Dim x As Variant
If Trim(pntxt.Value) = vbNullString Then
MsgBox "Enter Part Number"
Else
partno = pntxt.Value
Sheets("MASTER").Select
Set wS = Worksheets("MASTER")
lastRow = wS.Cells(Rows.count, 2).End(xlUp).Row
For x = 2 To lastRow
If wS.Cells(x, 2).Value = partno Then Rows(x).Select
Next
rowSelect = ActiveCell.Row
Cells(rowSelect, 20) = Me.pricetxt.Value
End If
End Sub
The code above does not returned the "pricetxt" values to the corresponding rows as "pntxt" values.
The code I've written below to replace some index match formulas in a sheet. It seems to work well enough, but I think the loop is a bit clumsy and may be prone to errors. Does anyone have any recommended improvements?
Sub match_SIC_code_sheet_loop()
'sic code needs to match value in column j or a in sic code sheet, '
'if not available = met10 works, but probably needs a bit more
'debugging to make it robust.
Dim ws As Integer
Dim lastrow As Long
Dim lastrow_sic As Long
Dim output_wb As Workbook
Dim SIC_sheet As Worksheet
Dim Demand_CAT As String
Dim sic_DMA As String
Dim i As Integer
Dim row As Integer
Dim WS_count As Long
Dim x As String
Dim y As String
Set output_wb = Workbooks("DMA_customers_SICTEST.xlsx") 'use thisworkbook instead
Set SIC_sheet = Workbooks("DMA_metered_tool_v12_SICTEST.xlsm").Sheets("SIC codes")
With SIC_sheet 'count the number of SIC codes to search through
lastrow_sic = .Range("j" & .Rows.Count).End(xlUp).row
End With
With output_wb 'count the no. of sheets in the generated customer workbook
WS_count = output_wb.Worksheets.Count
End With
With output_wb
For ws = 1 To WS_count 'loop through each sheet in the customer workbook
With output_wb.Sheets(ws)
y = output_wb.Sheets(ws).Name
lastrow = .Range("a" & .Rows.Count).End(xlUp).row ' number of rows in the
'current customer sheet
For i = 2 To lastrow 'data starts in row 2; sic code in column 9
sic_DMA = .Cells(i, 9).Text 'the lookup value
With SIC_sheet
'SIC codes start in row 2, if the sic code matches,
'the correct demand category is appointed, if the sic code does not
'match, then MET_10 is given as the default value.
For row = 2 To lastrow_sic
x = .Cells(row, 3).Text
If x = sic_DMA Then
Demand_CAT = .Cells(row, 10).Text
Exit For
Else
Demand_CAT = "MET_10"
End If
Next row
output_wb.Sheets(ws).Cells(i, 23).Value = Demand_CAT
End With
Next i
End With
Next ws
End With
output_wb.Save
End Sub
Thanks
For starters you could break that long procedure into a few smaller methods. For example you could have a ProcessSheet procedure into which you pass each sheet under :
For ws = 1 To WS_count 'loop through each sheet in the customer workbook
That would definitely help readability etc. If you're still not satisfied then continue breaking the loop into smaller logical procedures. Just don't go too crazy.
Apart from that some error checking and value validation would go a long way in a deeply nested loop. For example ensure that various calculated variables such as 'lastrow' are correct or within a valid threshold etc.
Finally instead of hardcoded values sprinkled through your long loop like magically camoflauged debug-from-hell-where's-waldo fairies; prefer instead a few meaningfully named Const variable alternatives i.e.
Private Const SIC_START_ROW = 2
Good afternoon folks,
I've been a long time reader but first time poster. I am doing a project that requires me to take trial balance data in Excel and format that data into a "balance sheet".
Basically I have the trial balance data in one worksheet ("Data") and the balance sheet template in another sheet ("Balance Sheet")
I need to populate the balance sheet from the ("Data") sheet to the ("Balance Sheet"). I am having trouble wrapping my head around how to do this
I have a first macro that I recorded that formats the trial balance data by account number and a second macro that sums together each group of accounts (ex. all cash accounts on are summed together on one line in the balance sheet).
But I am having trouble making this code robust and flexible, currently it is hard coded to the values in the balance sheet. How can I make this code flexible so that it populates correctly, (for example, if I added another "cash" account to the cash group, it would add that amount to the "cash" line in the balance sheet)
Here is the file if needed to look into it. Not a whole lot of code so any help would be greatly appreciated!
http://s000.tinyupload.com/?file_id=22382427361802516291
http://imgur.com/a/bYjUp
I haven't downloaded your project yet but it seems that what you need to do is create an array for each type of account. For simplicity, let's say you just have arrCash and arrLiability. You would then fill the arrays with each known gl code.or another way would be to keep a list of gl codes on a seperate spreadsheet. Now comes the fun part. You would loop through your excel spreadsheet and compare each code to the elements in your arrays. If the comparison equals true then add that amount to a one of your variables. If the comparison equals false then create a routine that redims the array the gl code needs to be added to then adds that gl code to the array. Or adding to that seperate spreadsheet. After adding the new gl code to the array you would need to add that amount to it's corresponding variable. After all calculations are completed, then you would update your balance sheet with the amoubts in the variables. Easy enough, right?
The following function accepts a comma delimited list of values (the value from column a in Data sheet) and will sum all rows in the data sheet that match the provided values.
eg: ?getSum("10300-000,10303-000") = 433094.74
Public Function getSum(ByVal Search As String) As Double
Dim Data As Worksheet: Set Data = ThisWorkbook.Worksheets("Data")
Dim List() As String: List = Split(Search, ",")
Dim ListSize As Integer: ListSize = UBound(List)
Dim Values() As Variant
Dim Row As Integer
Dim Rows As Integer
Dim Match As Integer
Dim Matched As Boolean
Dim Result As Double: Result = 0
Rows = Data.Range("A" & Data.Rows.Count).End(xlUp).Row
Values = Data.Range("A1", "C" & Rows).Value2
Row = 1
Do
Matched = False
For Match = 0 To ListSize
If Values(Row, 1) = List(Match) Then
Matched = True
Exit For
End If
Next Match
If Matched = True Then
Result = Result + CDbl(Values(Row, 3))
End If
If Row >= Rows Then
Exit Do
Else
Row = Row + 1
End If
Loop
getSum = Result
End Function
Updated to allow range of accounts instead of list
Public Function getSum2(ByVal sFirst As String, ByVal sLast As String) As Double
Dim Data As Worksheet: Set Data = ThisWorkbook.Worksheets("Data")
Dim Values() As Variant
Dim Row As Integer
Dim Rows As Integer
Dim First As Long: First = CLng(Left(sFirst, 5))
Dim Test As Long
Dim Last As Long: Last = CLng(Left(sLast, 5))
Dim Result As Double: Result = 0
Rows = Data.Range("A" & Data.Rows.Count).End(xlUp).Row
Values = Data.Range("A1", "C" & Rows).Value2
Row = 1
Do
Test = CLng(Left(Values(Row, 1), 5))
If Test >= First And Test <= Last Then
Result = Result + CDbl(Values(Row, 3))
End If
If Row >= Rows Then
Exit Do
Else
Row = Row + 1
End If
Loop
getSum2 = Result
End Function