setting border property in excel using a vbscript macro - excel

I have a macro written with vbscript that populated an excel worksheet with data pulled from my database. I need to format a line to have a top border across 3 columns. Nothing I've tried works. Here's where I need the border
objExcel.Cells(rowNum + 2, 6).Value = "SUB TOTAL"
objExcel.Cells(rowNum + 2, 8).Value ="=SUM(H7:H"&finalRowNum&")" 'Extended Cost subtotal'
objExcel.Cells(rowNum + 2, 9).Value ="=SUM(I7:I"&finalRowNum&")" 'low price subtotal'
objExcel.Cells(rowNum + 2, 10).Value ="=SUM(J7:J"&finalRowNum&")" 'list price subtotal'
objExcel.Cells(rowNum + 2, 11).Value = "=H"&finalRowNum + 1&"*L"&finalRowNum + 1 'price quote' 'for included the markup going on the subtotal for all quoted items
objExcel.Cells(rowNum + 2, 12).Value ="2.00"
objExcel.Cells(rowNum + 2, 12).Interior.Color = RGB(255, 255, 153)

I got it to work using this
subTotalRange = "F" &rowNum +2&":L"&rowNum + 2
objWorkSheet.Range(subTotalRange).Borders(8).linestyle= 1

Related

Select one record from Userform listbox with same ID, and only edit values in selected record

I'm 95% complete on my workbook, and I run into new problem. Screen shot of situation: https://ibb.co/Z6dZN18
Intro: I have Userform for situations like this with listbox, when I enter ID for search in Txtbox7 label ID, search results are shown in listbox.
Next when I dbl_click on desired search result I populate corresponding text boxes. Problem happens when I issue partial amount of some product that have ID 35 for example. On stocks I have 500 units of that product (ID 35) and I need to give 300 units. When I generate new transfer record in second worksheet "Izdato" I have Product ID 35 with 300 units, and in first sheet "RM" ID 35 have 200 units (500-300=200).
Couple days later, when I give them remaining 200 units, I will create a new record on sheet "Izdato" with same ID 35, bcs its the same product, and I can't sum those quantities in same (row) record because of transfer history, and that works like intended.
Here comes my problem, sometimes I need to return issued amounts from sheet "Izdato" back to sheet "RM" and when I dbl_click on record in listbox which I want to return and set quantity to 0 (zero) because it's returned. Excel change quantity value for all records that have same ID, and I want only to change selected record.
In screenshot link above, in orange filled row I want to set quantity to zero, because it return 200 units to storage. And when I do that via userform I change value in green filled row, because it have same ID and I don t want that to happen.
Is there any way to prevent that from happening without changing ID number? If it's of any good, I use this code for search and display data in listbox:
Private Sub CommandButton8_Click()
Dim sh As Worksheet
Set sh = Sheets("Izdato")
Dim i As Long
Dim x As Long
Dim p As Long
Me.ListBox1.Clear
'code for header
Me.ListBox1.AddItem "ID"
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = "Box number"
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = "Name"
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = "Quantiy"
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = "Measurment"
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = "Status"
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = "Date of return"
Me.ListBox1.List(ListBox1.ListCount - 1, 7) = "Note"
For i = 1 To sh.Range("A" & Rows.Count).End(xlUp).Row
For x = 1 To Len(sh.Cells(i, 1))
p = Me.TextBox7.TextLength
If LCase(Mid(sh.Cells(i, 1), x, p)) = Me.TextBox7 And Me.TextBox7 <>
""Then
With Me.ListBox1
.AddItem sh.Cells(i, 1)
.List(ListBox1.ListCount - 1, 1) = sh.Cells(i, 2)
.List(ListBox1.ListCount - 1, 2) = sh.Cells(i, 3)
.List(ListBox1.ListCount - 1, 3) = sh.Cells(i, 4)
.List(ListBox1.ListCount - 1, 4) = sh.Cells(i, 5)
.List(ListBox1.ListCount - 1, 5) = sh.Cells(i, 10)
.List(ListBox1.ListCount - 1, 7) = sh.Cells(i, 13)
.List(ListBox1.ListCount - 1, 6) = sh.Cells(i, 9)
End With
End If
Next x
Next i
End Sub
Once again, thanks in advance!

Matching values from a range on a different sheet VBA

I have two tables, each one on different sheets. The first table is the one to be filled. It contains 4 columns, the first column contains code ie: "10007", "10009", the second column has the type of product ie: "H10", "H12", etc, and each type of product uses a type of flour, the third column has the demand of such products and the last column has the consumption, which is the one I am trying to obtained.
The second table indicates which values on the demand column can be sum to obtained the consumption of each product.
Example:
Table 1:
Week 1 CODE Flour Consumption Product Demand
1007 GF H102 152
1008 Regular H104 450
H105 256
Table 2
Product Code Flour
H102 1007 GF
H104 1007 GF
H105 1008 Regular
So for example, if i am looking for the consumption of 1007 from table 1 then I have to sum the demand if the product matches on the second table. So basically on the second table you find like a guide that it tells you product x is form by code x and flour x, so when you go to the first week you base the consumption on how it matches to the guide. Therefore, the first consumption should be 152+450 since H102 and H104 have the same code, and the second consumption should be just 256.
I was using range to see if the code will try to match the value on table 1 to table 2.
Dim i As Integer
For i = 14 To 76
If Cells(i, 23).Value = Worksheets("Products").Cells(15, 8).Value And Cells(i, 29).Value = Worksheets("Products").Range("B15:B36").Value And Cells(i + 1, 29).Value <> Worksheets("Products").Range("B15:B36").Value And Cells(i + 2, 29).Value <> Worksheets("Products").Range("B15:B36").Value Then
Cells(i, 25).Value = Cells(i, 28).Value
ElseIf Cells(i, 23).Value = Worksheets("Products").Cells(15, 8).Value And Cells(i, 29).Value = Worksheets("Products").Range("B15:B36") And Cells(i + 1, 29).Value = Worksheets("Products").Range("B15:B36") And Cells(i + 2, 29).Value <> Worksheets("Products").Range("B15:B36") Then
Cells(i, 25).Value = Cells(i, 28).Value + Cells(i + 1, 28).Value
ElseIf Cells(i, 23).Value = Worksheets("Products").Cells(15, 8).Value And Cells(i, 29).Value = Worksheets("Products").Range("B15:B36") And Cells(i + 1, 29).Value = Worksheets("Products").Range("B15:B36") And Cells(i + 2, 29).Value = Worksheets("Products").Range("B15:B36") Then
Cells(i, 25).Value = Cells(i, 28).Value + Cells(i + 1, 28).Value + Cells(i + 2, 28).Value
End If
Next i
where cell (i,23) is the column with the codes and cell(15,8) is the cell with the fix product I am first working on to find on the second table. So if the first product belongs to the code on table 1 but the second and third product doesnt, then just write the same demand. if the first and second product belongs to the code and the third doesnt, then just sum the first and the second demand, and so on. I also tried with a for loop but it didnt work since it was evaluating cell by cell, and I need it to evaluate the whole range.
I also tried using Vlookup so It would look for the product type of Table 1 on Table 2. So if the code on Table 1 = the code that belongs to the product on Table 1 then do x
For i = 14 To 76
If Cells(i, 23).Value = Application.WorksheetFunction.VLookup( _
Cells(i, 29).Value, Worksheets("Products").Range("B15:H36"), 7, False) Then
Cells(i, 25).Value = Cells(i,28).Value
End If
Next i
Where (I,23) is the code on table 1 (1007), (i,29) is the product type on table 1 (H102), (i,25) is the consumption and (i,28) is the demand. This is only for the case where the rest of the products doesnt share the same code so there is no sum needed.

Do loop runs one too many times

So im trying to create a macro in VBA that finds a header e.g. Product number, then pastes all the product numbers and products (the adjacent column) in another workbook (Bill) in the format,
product number - product
until it reaches two blank cells. The problem is the loop runs one too many times and then pastes all the rows followed by "Error" and the red cell because both cells are blank. I've omitted a lot of lines for conciseness, but if it helps im happy to post the rest of it. Ive tried multiple things but just cant fix it. Any help would be appreciated. Thanks in advance.
Set wsDest = Workbooks("Bill.xlsx").Worksheets("Bill")
Lastrow = wsDest.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Offset(RowOffset:=1).Row
Do Until IsEmpty(Cells(i, j)) And IsEmpty(Cells(i, j + 1))
Set ANextFreeCell = wsDest.Cells(Lastrow, "L")
If IsEmpty(Cells(i + 1, j)) Or IsEmpty(Cells(i + 1, j + 2)) Then
ANextFreeCell = "Error"
ANextFreeCell.Interior.Color = RGB(255, 199, 206)
Else
ANextFreeCell = Cells(i + 1, j) & " - " & Cells(i + 1, j + 2)
End If
i = i + 1
Lastrow = Lastrow + 1
Loop

Return multiple data from Excel sheet using VBA

I have a slight problem. I created a UserForm with 40 TextBoxes that submits its contents to sheet1.
The userform generates a time stamp in a label (label2) using Format(Now(), "H:MM").
When I click the submit button upon filling the form, each filled TextBox is submitted to column 1 in sheet1 alongside the time stamp to column 2 in sheet1.
See code below:
Dim Emptyrow As Long
Emptyrow = Worksheetfunction.CountA(Range(A:A)) + 1
Cell(Emptyrow, 1) = textbox1.Value
Cell(Emptyrow, 2) = label2.Value
Cell(Emptyrow + 1, 1) = textbox2.Value
Cell(Emptyrow + 1, 2) = label2.Value
Cell(Emptyrow + 2, 1) = textbox3.Value
Cell(Emptyrow + 2, 2) = label2.Value
Cell(Emptyrow + 3, 1) = textbox4.Value
Cell(Emptyrow + 3, 2) = label2.Value
Cell(Emptyrow + 4, 1) = textbox5.Value
Cell(Emptyrow + 4, 2) = label2.Value
.
.
.
.
Cell(Empty row + 39, 1) = textbox40.Value
Cell(Empty row + 39, 2) = label2.Value
All filled textboxes submitted at an instance will have the same time stamp in column 2.
I want a situation where I can recall all contents submitted to sheet1 back to the TextBoxes using the time stamp as my filter.
I would like to achieve this by placing a recall TextBox at the top of the UserForm and then filling the desired time stamp as my search criteria to recall contents from column 1 in sheet1.
I know this is possible, but I don't know how to go about it.

Set that a cell always has the same value as another (actively)

I'm making a macro that inserts a row on one sheet and then inserts this row in all the sheets but the separate columns should refer to the value of the general sheet.
E.g.:
I have 3 sheets and a template sheet.
Then I want to run a macro that inserts a row in the template sheet with some values.
And loops through all 3 sheets inserts the row in the same spot, and then comes the difficult part, it gives an active link to the template sheet cells.
So that when somebody changes the value of one of the cells on the template this value gets changed on all the different tabs.
I have this but this is not an active link it only sets the status of the value from that time and I can't find the syntax to make it an active reference.
For Each Current In Worksheets
Current.Cells(startCell.Row, startCell.Column).Offset(1).EntireRow.Insert
Current.Cells(rowNumber + 1, 1).Value = ws.Cells(rowNumber + 1, 1).Value
Current.Cells(rowNumber + 1, 2).Value = ws.Cells(rowNumber + 1, 2).Value
Current.Cells(rowNumber + 1, 2).Borders.LineStyle = xlContinuous
Current.Cells(rowNumber + 1, 3).Value = ws.Cells(rowNumber + 1, 3).Value
Current.Cells(rowNumber + 1, 3).Borders.LineStyle = xlContinuous
Current.Cells(rowNumber + 1, 4).Value = ws.Cells(rowNumber + 1, 4).Value
Current.Cells(rowNumber + 1, 4).Borders.LineStyle = xlContinuous
Current.Cells(rowNumber + 1, 5).Value = ws.Cells(rowNumber + 1, 5).Value
Current.Cells(rowNumber + 1, 5).Borders.LineStyle = xlContinuous
Next Current
The thing I was looking for was this:
'First get the address you need from that cell
testString = Range(Cells(2, 2), Cells(2, 2)).Address
'Add the = in front of the address
ActiveSheet.Cells(1, 1) = "=" & testString
But I had trouble wording what I needed and the solution I've provided works but is not nice coded.
If somebody has a better solution please be so kind...

Resources