inserting calculated values at the end of row with values - vba

My data set column is H through BQ with 3000 rows.
I have column H with values in some rows and no value in others. First, I am trying to find the row with value. Once I do that I want to divide that value by the corresponding value in column I to get the answer X. Finally, I then want to repeat the value in column I – X times at the end of that row which has any value
For example:
Row Number Column H Column I Column J Column K Column L
1
2 1400 200 300 200 200
3
4 2000 1000
5 400
Expected results:
Row 2:
1400/200 = 7. I want to repeat the value in Column I(200) 7 times after Column L
Row 4:,
2000/1000 = 2. I want to repeat the value in Column I (1000) 2 times starting in Column J
Row 5: 400/0 = Error. In this case repeat the value in Column H (400) once in Column I.

This should meet your requirements:
Sub DoThisThing()
Dim rCell As Range, OrCell As Range, startCol As Integer, dividingIntger As Integer, _
answer As Double, searchRng As Range, WS As Worksheet
Set WS = Sheets(ActiveSheet.Name) 'Or use actual sheet name i.e. Set WS = Sheets("Sheet1")
Set searchRng = WS.Range("H1:H3000") 'sets the range to search through.
For Each rCell In searchRng.Cells
'If Column H is a numeric value, but not empty
If IsNumeric(rCell) And Not IsEmpty(rCell) Then
'Establishes offset cell being used
Set OrCell = rCell.Offset(0, 1)
'If column I has a numeric value that's not zero or blank
If IsNumeric(OrCell) And OrCell.Value2 <> 0 Then
'Number of columns to offset (rounded up)
dividingIntger = Application.WorksheetFunction.RoundUp(rCell.Value2 / OrCell.Value2, 0)
'Exact answer (decimals okay)
answer = rCell.Value2 / dividingIntger
'Finds which column to start entering values
startCol = WS.Cells(rCell.Row, Columns.Count).End(xlToLeft).Column + 1
'sets answer value into the starting column and over (less 1)
Range(WS.Cells(rCell.Row, startCol), WS.Cells(rCell.Row, startCol).Offset(0, dividingIntger - 1)).Value2 = answer
'If column I is zero or blank
ElseIf IsNumeric(OrCell) Then
'Sets Column I = to Column H
OrCell.Value2 = rCell.Value2
End If
End If
Next rCell
End Sub
'☠☠☠☠system tested!👍👍☄⚡✨💥

Related

Excel VBA: Insert row into table and fill down everything from row above

I have a problem with a little bit of VBA code I pulled together and I just can't find an answer somewhere else.
I have a table named TableOPQuery which has over 40 columns and over 10k rows.
There is a column called SPLITS where the user will write a value x (integer). If that value is greater than 1 then a row will be inserted under the row where the user wrote the value, because the purpose of that value is to add rows and copy everything the original row had (values, formulas, format) to make the same amount of rows specificied by the user including the original one, so it woul be like "x - 1".
Here is an example, because I propably couldn't explain it good enough:
Order Provider Amount Type Splits Shipped
23 Shady company 10000 Whole 1
30 That company 2000 Split 2
*30 That company 2000 Split*
35 This company 420 Whole
So, you see, in row 1 (order 23), the user wrote 1, so no rows will be inserted. But, in row 2 (order 30), the user wrote 2. So one more row will be inserted, copying everything from the row above (the one where the user inserted 2), to make 2 rows identical to each other.
I managed to piece toger this code that helps me in inserting whatever amount of rows the user wants, but for some reason I can not make it fill down from the original row where the user wrote the value and I want it to clear the contents in the SPLIT row to not trigger the code again.
I am stumped now, because the normal filldown fuction doesn't work. I can insert rows, but I cant copy and fill down everything the row above has, and I can't clear the column SPLITS either.
Private Sub Worksheet_Change(ByVal Target As range)
Dim KeyCells As range
Dim xValue As Integer
Dim tbl As ListObject
Dim tRows As Long
Dim tCols As Long
Dim originCell As String
'I call a fuction that will give me the position of the column that has SPLITS in it, searching a predefined row (5:5). I know this is unnecessary but this is the best I could do because the column SPLITS might change of position (add/delete columns)
col = ColumnNumberByHeader("Splits")
'I use this to get the amount of rows the table has mostly
Set tbl = ActiveSheet.ListObjects("TableOPQuery")
With tbl.DataBodyRange
tRows = .Rows.Count
tCols = .Columns.Count
End With
'An If to get a range using the a predefined start row (5), the col I got earlier, and the amount of rows the table has. If I get 0 as col is because the column does not exist
If col <> 0 Then
Set KeyCells = range(Cells(5, col), Cells(tRows, col))
Else
Cancel = True
MsgBox "Check that column SPLITS exist"
Exit Sub
End If
'Here is where the level noob magic happens. Rows start getting inserted if a value in the range I got in KeyCells happens
If Not Application.Intersect(KeyCells, range(Target.Address)) Is Nothing Then
'If the value is not numeric then nothing will run
If IsNumeric(Target) Then
'If the target is greater than 1 then the amount of Target.Value minus 1 of rows will be inserted under the row where the change occurred
If Target.Value > 1 Then
originCell = Target.Address
xValue = Target.Value - 1
MsgBox "Cell " & Target.Address & " has changed."
'A loop to insert the rows, I use - 4 because the Target.Address is of the whole worksheet, and not the table itself.
For i = 1 To Target.Value - 1 Step 1
tbl.ListRows.Add (range(Target.Address).row - 4)
'Filling down into the inserted rows from the row of the originCell (where the user inserted the value)
range(originCell).EntireRow.FillDown
Next i
End If
End If
End If
End Sub
Assumption
Sheet name (that contains the table): Sheet1
Table Name: TableOPQuery
Corresponding column header: Splits
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Name = "Sheet1" Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim tbl As ListObject
Dim rng As Range
Dim SCI As Integer 'Specific Column Index
Dim CN As String 'Column Name
CN = "Splits"
Set tbl = Worksheets("Sheet1").ListObjects("TableOPQuery")
Set rng = Range("TableOPQuery[#All]")
SCI = Application.WorksheetFunction.Match(CN, Range("TableOPQuery[#Headers]"), 0)
If Cells(rng.Row + rng.Rows.Count - 1, rng.Column + SCI - 1) > 1 Then
tbl.ListRows.Add
Range(Cells(rng.Row + rng.Rows.Count, rng.Column).Address & ":" & _
Cells(rng.Row + rng.Rows.Count, rng.Column + rng.Columns.Count - 1).Address).FillDown
End If
End If
Application.EnableEvents = True
End Sub

VBA to Count the value in column and fill the table in another sheet

I am having two Sheets , sheet1 and sheet2.
I have a table with the weekno, delay , Ok, percenatage of Delay and Percentage of OK.
In sheet 1, i am looking for the column T, and Count the number of '1' in the column. Similarly i look for column U and Count the number of '0' in the column.
the Count value has to be filled in sheet2 of the table looking into the week. I have my week in the column AX of sheet1.
I used formula like Countif for calculating the number of 1 in both the column.
could someone guide me how we can do it in VBA, to Count the value in column and pasting the result in a table in another sheet.I am struck how to start with coding. This is my sheet1, i have to Count the number of 1 in column t and u
To solve this problem, we have to use a couple of loops. First, we have to do an outer loop to go through the week numbers in sheet2, then imbedded in that loop we have to look at each row in sheet1 to see if it matches the week from sheet2 and to see if column T = 1 and if column U = 0. The code creates a counter that increase T by one every time a row in T is equal to 1 and does the same for U every time a row in U = 0.
Sub test()
Dim col As Range
Dim row As Range
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim T As Integer
Dim U As Integer
Dim wk As String
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
For Each col In sh2.Columns 'This loops through all populated columns in row one
If sh2.Cells(1, col.Column).Value = "" Then
Exit For
End If
wk = sh2.Cells(1, col.Column).Value
For Each rw In sh1.Rows
If sh1.Cells(rw.row, 50).Value = "" Then
Exit For
End If
If sh1.Cells(rw.row, 50) = wk And sh1.Cells(rw.row, 20) = 1 Then
T = T + 1
End If
If sh1.Cells(rw.row, 50) = wk And sh1.Cells(rw.row, 21) = 0 Then
U = U + 1
End If
Next rw
sh2.Cells(2, col.Column) = T 'put counters into 2nd and 3rd row under each week, you can adjust this to put the number in a different cell.
sh2.Cells(3, col.Column) = U
T = 0 'reset counters to start looking at next week.
U = 0
Next col
End Sub
For some reason I wasn't able to view the images that you just uploaded. You may have to adjust my code to adapt to the specifics of your excel file. It will be good VBA practice for you. My code assumes the sheet2 has the week numbers going across the columns without any blank cells in between them. The vba drops the code in the 2nd and 3rd row under the corresponding week number. You can change this by changing the code that is indicated in the comments.

VBA Excel - select all rows with value in a column

I have a spreadsheet named "Copy" sorted by numeric values (lowest to highest) in column H. The sheet has headers in row 1. The lowest value in column H is 0. I would like to find the last row that has column H equal 0 and then select the range of rows where column H equals 0 along with the header row.
Thanks!
This will do the job
Sub CustomSelect()
Dim i As Long: i = 2
Do While Range("H" & i).Value = 0
i = i + 1
Loop
Range("H1:H" & i - 1).EntireRow.Select
End Sub

Compare given cells of each row of two tables

I am looking to update the last column of one data table with the last column of another data table. This is part of a bigger vba code. The first table spreads from A2 to column K and row "lastrpivot1". The second goes from A1001 to column K and row "lastrpivot2". Beginning with the first row of table 2 (row1001) i have to find the equivalent row in table 1 based on the values in cells A to E.
So cells A to E or frow 1001 have to be compared to cells A to E of row 2, then row 3, then row 4... until a match if found or until row "lastrpivot1". When a match is found, the value in K must return to the K value of row 1001. EX: if AtoE of row 1001 match row AtoE of row 65, then copu K65 to K1001. there shound not be more than 1 match from each table. and if there is no match there is nothing to return.
Then we start this all over for row 1002 (second row of second chart), then 1003, 1004... to lastrpivot2.
I do use vba but i do not know all the functions. this is probably why i cant figure this out.
Thnka you
In Cell K1001, try this:
=IF((A1001&B1001&C1001&D1001&E1001)=(A1&B1&C1&D1&E1),K1,"")
Then drag the formula down.
This compares the entire row 1001 to the entire row 1, which is what you're asking for.
If you intend to find the matching row like a VLOOKUP (you kind of imply this, but it is not clear that this is your intention) then you will need to use VBA to do this.
Something like (untested):
Sub MatchTables()
Dim tbl1 as Range, tbl2 as Range
Dim var1() as Variant, var2() as Variant, v as Variant
Dim r as Long, matchRow as Long
Set tbl1 = Range("A1:K500") '## Modify as needed
Set tbl2 = Range("A1001:K15001") '## Modify as needed
ReDim var1(1 to tbl1.Rows.Count)
ReDim var2(1 to tbl2.Rows.Count)
'## store the range values, conctaenated, in array variables:
For r = 1 to tbl1.Rows.Count
var1(r) = tbl1(r,1) & tbl1(r,2) & tbl1(r,3) & tbl1(r,4) & tbl(r,5)
Next
For r = 1 to tbl2.Rows.Count
var2(r) = tbl2(r,1) & tbl2(r,2) & tbl2(r,3) & tbl2(r,4) & tbl2(r,5)
Next
r = 0
For each v in Var2
r = r+1
'## Check to see if there is a complete match:
If Not IsError(Application.Match(v, var1, False)) Then
matchRow = Application.Match(v, var1, False)
'## If there is a match, return the value from column K in the first table:
tbl2.Cells(r,11).Value = tbl1.Cells(matchRow,10).Value
Else:
tbl2.Cells(r,11).Value = vbNullString
End If
Next
End Sub

Is it possible to give the count of maximum columns used by a particular row(s)

I have a Excel matrix as below:
PID# T1 T2 T3 T4 T5 T6 T7
11 1 1
14 1 1 1
21 1 1
41 1 1 1 1
71 1
88 1 1 1
PID# is nothing but the processes, all the processes has been composed of multiple tasks. But it is not mandatory that all processes should use all the T1 - T5 tasks. In such a scenario is it possible to get the PID# which used maximum tasks. 1 used to indicate that a task has been used or not. here the PID# 41 and 88 used maximum tasks say it is 5. I need only the maximum used column count and any of the row# which used that number of columns.
NOTE
here i have used 1 to tell there is data,but in reality there are different types of data. I need to find out which row used maximum columns.But one thing if any cells for a row is blank and it is to the left,should be in the count. say for example --
<> 1 <> 1 gives the count as 4
<> <> 1 <> will give the count as 3
1 1 <> will give the count as 2 ' here I used <> used to represent the no values
EDIT
Option Explicit
Dim ArrayListTaskDetails : Set ArrayListTaskDetails = CreateObject("System.Collections.ArrayList")
Dim i,colcount
i=2
Do while i < = objExcel1.Application.WorksheetFunction.CountA(ob.Rows(1))
colcount=objExcel1.Application.WorksheetFunction.CountA(ob.Rows(i))
ArrayListTaskDetails.Add(colcount)
i=i+1
Loop
ArrayListTaskDetails.Sort()
i=ArrayListTaskDetails.Count
MsgBox("HighestColumnNumner:" & ArrayListTaskDetails(i-1))
Problem:
I can't count the blank columns for rows which don't have the contiguous value. Thus count is not produced by me correctly.
EDIT1
Here the problem is still i can't count the left blank cells if any,as those are also to be considered as used column,in which other rows can have values.Thus need to find out the the right most column which has been used by a row after which no columns has been used by any rows. Hope I am able to clear what I am looking for:
Option Explicit
Dim objExcel1
Dim strPathExcel1
Dim objSheet1,objWB,ColCount
Dim ArrayListTaskDetails : Set ArrayListTaskDetails = CreateObject("System.Collections.ArrayList")
Set objExcel1 = CreateObject("Excel.Application")
strPathExcel1 = "D:\AravoVB\.xlsx"
Set objWB = objExcel1.Workbooks.open(strPathExcel1)
Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)
Do Untill count > objExcel1.Application.WorksheetFunction.CountA(objSheet1.Rows(1))
Range = objSheet1.("count:count")
ColCount=objExcel1.Application.WorksheetFunction.CountIf(Range,<> "")
ArrayListTaskDetails.Add(ColCount)
Loop
ArrayListTaskDetails.Sort()
MsgBox(ArrayListTaskDetails(ArrayListTaskDetails.Count - 1))
Thanks,
Still not convinced why Vikas answer is not working for you. Try this code please. It highlights the last max value. Only flaw is that it doesn't track all the PID that has same max value. I could improve the code if you need that as well.
Code:
Option Explicit
Sub getRealUsedColumns()
Dim rngInput As Range
Dim arrInput As Variant, arrRowTotal As Variant
Dim i As Integer, j As Integer, counter As Integer, iTemp As Integer
Dim iPID As Integer, maxRowNum As Integer
arrInput = Application.WorksheetFunction.Transpose(Sheets(3).Range("B3:I8").Value2)
ReDim arrRowTotal(LBound(arrInput, 2) To UBound(arrInput, 2))
For i = LBound(arrInput, 2) To UBound(arrInput, 2)
counter = 0
For j = LBound(arrInput) + 1 To UBound(arrInput)
If arrInput(j, i) <> "" Or Not IsEmpty(arrInput(j, i)) Then
counter = counter + 1
End If
Next j
'-- most recent max value (if you have two of the same, this doens't catch)
'-- you need to save in a proper array to catch multiple PIDs with same max value
If iTemp <= counter Then
iTemp = counter
iPID = arrInput(1, i)
maxRowNum = i
End If
arrRowTotal(i) = counter
Next i
'-- Row total into the sheet output
Sheets(3).Range("J3").Resize(UBound(arrRowTotal)) = _
Application.WorksheetFunction.Transpose(arrRowTotal)
'-- highlight the max total row.
With Sheets(3).Range("B3").Offset(maxRowNum - 1, 0).Resize(1, UBound(arrInput, 1) + 1)
.Interior.Color = 200
End With
End Sub
Results:
Excel is very powerful in calculating Matrix. I would use the Excel Formula instead of Code in order to calculate it. I would add a column in the right, which would add the total number of tasks used by a process, as shown in the matrix below.
A B C D E F G
1 PID T1 T2 T3 T4 T5 Total
2 #11 1 1
3 #14 1 1 1 3
4 #21 1 1 1 1 1 5
5 #41 1 1 2
Then I will write two Array Formulas to calculate the maximum number of tasks used by a process and the name of that process.
Formula to calculate maximum tasks used in the example: =SUM(IF($G$2:$G$5=MAX($G$2:$G$5),G2:G5,0))
Formula to find the pricess which used the maximum tasks:
=OFFSET(A1,SUM(IF($G$2:$G$5=MAX($G$2:$G$5),ROW(G2:G5)-1,0)),0,1,1)
Please note that I had mentioned that I used Array formulas. In order to add array formula in Excel, you need to enter formula and then press "Ctrl+Shift+Enter" to make that formula an array formula.
Hope this helps.
Vikas B
-----------------EDIT-----------------------------------------------------
Adding the code here. I just used the sample, as show in matrix and produced the correct result.
Sub FindMax()
'assuming column 1 is the task ID and Row one has the headings.
Const LastColumn As Integer = 7 ' you can use xl end to get the last used column in the range
Const LastRow As Integer = 5
Dim rowCounter As Integer
Dim prevValue As Integer
Dim rngToTotal As Range
Dim sht As Worksheet
Dim maxRowName As String
Dim value As Integer
Dim maxValue As Integer
Set sht = ActiveSheet
For rowCounter = 2 To LastRow
Set rngToTotal = sht.Range(sht.Cells(rowCounter, 2), sht.Cells(rowCounter, LastColumn))
value = WorksheetFunction.Sum(rngToTotal)
If value > prevValue Then
maxRowName = sht.Cells(rowCounter, 1).value
maxValue = value
End If
prevValue = value
Next rowCounter
MsgBox "Process name " & maxRowName & " = " & maxValue
End Sub