Excel: Add sequential column using VBA - vba

I am trying to add a column in Excel using VBA for sequential numbers.
Column 1 Column 2
Xyz Data
Zyx Data
Yzx Data
I wish to add a numbered sequence to column 1.
Column 1 Column 2
1 Xyz Data
2 Zyx Data
3 Yzx Data
Also I would like to control where the sequence starts from. For example from 5 onwards....
Column 1 Column 2
5 Xyz Data
6 Zyx Data
7 Yzx Data
Any help is appreciated. Thanks

If you are working on Row 1 to 100 of column A, you could try this:
Dim startNum As Long
Dim offNum As Long
Dim i As Long
Let startNum = InputBox("Start from:")
Let offNum = startNum - 1
For i = 1 To 100
ThisWorkbook.Sheets(1).Cells(i, 1).FormulaR1C1 = "=Row(R" & i & "C1) + " & offNum
Next

Sub enumeration()
Dim j, k As Integer
'determine the number to start with
j = Application.InputBox("What number should I start with?")
'determine how many rows are there to enumerate
k = Cells(1, 2).CurrentRegion.Rows.Count
For i = 0 To k - 2
Cells(i + 2, 1).Value = i + j
Next i
End Sub

Related

Shuffle an existing column multiple times with no repeats on any row

I am using VBA
I have a column of integers in an array
I run the array thru a randomizer module and copy that to a second column
I run the array thru a randomizer module and copy that to a third column
I run the array thru a randomizer module and copy that to a fourth column
The issue I can't seem to over come is duplicates on the same row
IE:
2 13 27 14
27 27 13 5
14 5 2 13
13 2 14 27
5 14 5 2
*columns are much longer
I have searched the web but everyone is focused on creating random numbers without duplicate. I have found shuffling but once again it seems to be one dimensional.
'// get a random number from 1 to the last row of column 25
For N1 = 1 To LastRow
Again:
Randomize Timer
RNum = Int(Rnd * (LastRow - 1 + 1) + 1)
'// this is where the values in "NArray" get shuffled around
Temp = NArray(N1)
NArray(N1) = NArray(RNum)
NArray(RNum) = Temp
ws5.Cells(N1, Lp) = NArray(N1)
'// this looks for duplicate numbers in the row
Select Case Lp
Case 26: a = ws5.Cells(N1, Lp).Value + 0
b = ws5.Cells(N1, Lp - 1).Value + 0
If a = b Then
GoTo Again
End If
Case 27: a = ws5.Cells(N1, Lp).Value + 0
b = ws5.Cells(N1, Lp - 2).Value + 0
c = ws5.Cells(N1, Lp - 1).Value + 0
If a = b Then
GoTo Again
ElseIf a = c Then
GoTo Again
End If
...
'// the shuffled array is inserted into the cells of column 26
For N1 = 1 To LastRow
ws5.Cells(N1, Lp) = NArray(N1)
Next N1
Next Lp
no errors with the exception that when comparing cell values in the row going from column to column it misses duplicate values such as row 2 column 3 may contain "14" and row 2 column 4 contains "14" it doesn't loop back and get another value for column 4

Automatic sequential numbering with decimals based on arbitrary senority using VBA code on excel

I'd like Excel to automatically number each row I add with a sequential unique identifier that is dependent on the level of seniority that I've assigned to the row. (For example, if the row is a level 2, the task no. should be 2.1; if the next task is a level 1, the task no. should be 3). Lastly, I'd like it to be dynamic so if I were to add a row in the middle of the list, all the subsequent task no.s should become greater.
I founded pieces of VBA codes online but none that fits my purpose exactly. Was wondering if anyone has something for this purpose. Thanks for your help!
Level | Task No.
1 | 1
2 | 1.1
2 | 1.2
1 | 2
2 | 2.1
2 | 2.2
1 | 3
2 | 3.1
See illustration of table here:
No comments, but you should be able to follow...
Sub Label()
Const MAX_LEVELS As Long = 10
Dim levels(1 To MAX_LEVELS) As Long, i As Long, x As Long
Dim c As Range, s
Set c = ActiveSheet.Range("A1")
Do While Len(c.Value) > 0
s = ""
i = c.Value
levels(i) = levels(i) + 1
For x = i + 1 To MAX_LEVELS
levels(x) = 0
Next x
For x = 1 To i
s = s & IIf(s <> "", ".", "") & levels(x)
Next x
With c.Offset(0, 1)
.NumberFormat = "#"
.Value = s
End With
Set c = c.Offset(1, 0)
Loop
End Sub
Note it does not check you've been following the numbering scheme correctly (ie. if you go straight from level 1 to level 4 it won't warn you)

vba dynamic sum based on dynamic range values

I would like to thank everyone for their feedback so far it has helped a great deal. one question that I am grappling with is how to make my column values even so I can do a dynamic subtototal.
Column k Column R Column Y Column AF Column AM Column AT
1 2 4 2 3 5
3 9 7 8 2 4
2 3 6 3 5 8
3 3 2
5
TOT 9 14 25 13 12 17
Column k Column R Column Y Column AF Column AM Column AT
1 2 4 2 3 5
3 9 7 8 2 4
2 3 6 3 5 8
3 3 2
5
TOT 9 14 25 13 12 17
on a monthly basis the column values can fluctuate, the question is how do I use VBA to create a dynamic sum based on the column with the most values.
Dim Rin As Range
Dim Rout As Range
Dim lRa As Long
lRa = Range("i" & Rows.count).End(xlUp).Row
Set Rin = ws.Range("i" & lRa)
Set Rout = ws.Range("I" & lRa)
aCell.Range("I11:P12", "R12:AY12").Copy
Rout.Offset(2, 0).Resize(1, 28).Formula = "=SUBTOTAL(9," &
Rin.Address(0, 0) & ")"
lR = ws.Range("I" & Rows.count).End(xlUp).Row - 1 ' Finds the last blank
row
ws.Range("I" & lR).PasteSpecial xlPasteFormats
If you know where your data starts you can use a method such as that given by Shai Rado.
You can't have any entirely empty rows or columns in the range.
You can then feed this lastRow variable into the range address for adding your subtotal formula.
Example: If your data is a continuous set of populated columns starting at Cell D3 the following will get the last used row number in the range of columns:
Option Explicit
Public Sub AddSubTotal()
Dim lastRow As Long
Dim lastCol As Long
Dim firstRow As Long
Dim rowHeight As Long
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet2") 'change as appropriate
With ws.Range("D3").CurrentRegion 'change as appropriate
firstRow = .Rows(1).Row
lastRow = .Rows(.Rows.Count).Row
lastCol = .Columns(.Columns.Count).Column
rowHeight = lastRow - firstRow + 1
End With
With ws
.Range(.Cells(lastRow + 1, "D"), .Cells(lastRow + 1, lastCol)).FormulaR1C1 = "=SUBTOTAL(9,R[-" & rowHeight & "]C:R[-1]C)"
End With
End Sub
If you need a different method to find the last used row and last used column there a lots of available resources online including my favourite by Ron De Bruin Find last row, column or last cell. The appropriateness of each method is determined by the shape and properties of your range e.g. no blank columns or rows in range. So choose a method that is right for your data or that can test for different likely cases and apply different methodologies as appropriate.
It is quite difficult to give a definitive answer (and i don't want to code lots of different possible scenarios) to this question without knowing more about the nature and variability of the data. If you familiarise yourself with the methods of finding last row and column you will be able to implement those that suit your needs.

Generate table by VBA in Excel

I'm new in VBA. I hope that this is not a difficult question for you.My problem:
I have TEXT in column A and NUMBER in column B. Like this:
Column A Column B
TEXT 1 3
TEXT 2 2
TEXT 3 3
..... ...
I need to auto-generate a table in other sheet which has two columns. First contains the text which repeats n times (NUMBER in column B) and then the next text from Column A. In the second column of this table I need number from 1 to NUMBER. like this:
Column A Column B
TEXT 1 1
TEXT 1 2
TEXT 1 3
TEXT 2 1
TEXT 2 2
TEXT 3 1
TEXT 3 2
TEXT 3 3
.... ....
Then I have to post-process this table, but I know how to make it. I don't know how to generate the table.
Expanding on my comment:
Sub MakeTable()
Dim i As Long, j As Long, k As Long, m As Long, n As Long
Dim t As String
Dim ws As Worksheet
Sheets(1).Activate
Set ws = Sheets(2)
n = Cells(Rows.Count, 1).End(xlUp).Row()
k = 1
For i = 1 To n
t = Cells(i, 1).Value
m = Cells(i, 2).Value
For j = 1 To m
ws.Cells(k, 1).Value = t
ws.Cells(k, 2).Value = j
k = k + 1
Next j
Next i
End Sub
This assumes that the original data is in Sheet1 and you are transferring it to Sheet2, and that the data begins in row 1. Adjust accordingly if those assumptions are false. The way I determine the last cell in column A that has data is an important idiom in Excel VBA and should be mastered.

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