MS-Excel automatic increase number if text not same - excel

As shown above picture i need put number on column B that automatic increase if text on column A not same so the the result would be
Can I do that with ms-excel?

Put 1 on B1 and put below on B2 and drag down
=if(a2=a1, b1, b1+1)

Using vba, assuming your working on the 1st sheet, you can use code like this:
Sub uniqueIdx()
Dim idx As Integer: idx = 1
Dim c As Range
With Sheets(1)
For Each c In .Range("A1", .Cells(Rows.Count, 1).End(xlUp)):
.Cells(c.row, 2).Value = idx
If (c.Value <> c.Offset(1, 0).Value) Then idx = idx + 1
Next
End With
End Sub

Related

Create a header by determining when two cells do not match and pasting header from another sheet

I'm looking for something that is able to start searching in row 9 of column C for cells that do not equal cells 2 rows below. E.g. C9 <> C11, C10 <> C12, etc. Then Copy a cell from another sheet and paste it into Column A in the same row where there was the first discrepancy. E.G. if C9 <> C11, then paste from Sheet2 into A11. The purpose is to insert a new header after already formatting and sorting the data, below is one of the many variations I have tried, receiving only errors or blank inputs.
Any help would be greatly appreciated.
Dim iRow2 As Integer, iCol2 As Integer, iRow3 As Integer, iCol3 As Integer
Dim oRng2 As Range
Dim oRng3 As Range
Dim qqq As Range
Set oRng2 = Range("C9:C80")
Set oRng3 = Range("A9:A80")
iCol2 = oRng2.Column
iCol3 = oRng3.Column
For Each qqq In oRng2
Do
If qqq.Cells(oRng2, 3) <> qqq.Cells(oRng2 + 2, 3) Then
ThisWorkbook.Worksheets("Sheet1").Range("N1").Copy Destination = Sheets("Sheet2").Range(oRng2 + 2, 1)
End If
Loop While Not Cells(iRow2, iCol2).Text = ""
Next
I suggest you work with column numbers if you can. Then you will probably see that you need far less indices than your current code does, and you don't forget to update the indices (like currently iRow2 and iCol2) so easily.
Dim dataSheet As Worksheet
Dim headerSheet As Worksheet
Set dataSheet = ActiveWorkbook.Sheets(2)
Set headerSheet = ActiveWorkbook.Sheets(1)
Dim r As Integer
For r = 9 To 80
If dataSheet.Cells(r, 3).Value <> dataSheet.Cells(r + 2, 3).Value Then
dataSheet.Cells(r, 1).Value = headerSheet.Cells(1, 14).Value
End If
Next r
This should give you a good start. I don't know that exactly the inner loop is meant to check, because you're never touching iRow2 and iCol2 it will try to check the cell at R0C0 which is an invalid address. If you want to make sure the row you compare with isn't empty, check that first within the For loop:
...
For r = 9 To 90
If dataSheet.Cells(r + 2, 3).Value = "" Then
Exit For
ElseIf dataSheet.Cells(r, 3).Value <> dataSheet.Cells(r + 2, 3).Value Then
dataSheet.Cells(r, 1).Value = headerSheet.Cells(1, 14).Value
End If
Next r

Sum cell values below until blank cell

I need the excel formula to add the cell values until blank cell.
I have tried with the below formula :
=IF(A4="",SUM(A4:INDEX(A$1:$A4,MATCH(TRUE,(A$1:$A4=""),A4))),A4)
But it shows the wrong result.
Please see the picture below to understand, what kind of result I am searching for.
With blocks of data in column A, in B2 enter:
=IF(A2="",SUM($A$1:A2)-SUM($B$1:B1),"")
and copy downwards:
Each value in column B is the sum of the A-block above it.Using column B allows us to avoid having to figure out where in column A to put a SUM() formula.
If you want the result on the same column, give a try with this macro,
Sub total()
Dim i As Long, temp As Long
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row + 1
If Cells(i, 1) <> "" Then
temp = temp + Cells(i, 1)
Else
Cells(i, 1) = temp
temp = 0
Cells(i, 1).Interior.Color = vbYellow
End If
Next i
End Sub

Excel Loop Column A action column B

I'm currently looking for a code to improve my Dashboard. Actually, I need to know how to use a loop in a column X who will affect a column Y (cell on the same line).
To give you an example:
Column A: I have all Production Order (no empty cell)
Column B: Cost of goods Sold (Sometimes blank but doesn't matter)
I actually pull information from SAP so my Column B is not in "Currency".
The action should be:
If A+i is not empty, then value of B+i becomes "Currency".
It's also for me to get a "generic" code that I could use with other things.
This is my current code...
Sub LoopTest()
' Select cell A2, *first line of data*.
Range("A2").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
ActiveCell.Offset(0, 1).Style = "Currency"
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Another example, getting Last Row, in case your data contains any blank rows.
Sub UpdateColumns()
Dim wks As Worksheet
Dim lastRow As Long
Dim r As Long
Set wks = ActiveSheet
lastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
For r = 2 To lastRow
If wks.Cells(r, 1) <> "" Then
wks.Cells(r, 2).NumberFormat = "$#,##0.00"
End If
Next r
End Sub
I can see I was a little slower than the others, but if you want some more inspiration, heer is a super simple solution (as in easy to understand as well)
Sub FormatAsCurrency()
'Dim and set row counter
Dim r As Long
r = 1
'Loop all rows, until "A" is blank
Do While (Cells(r, "A").Value <> "")
'Format as currency, if not blank'
If (Cells(r, "B").Value <> "") Then
Cells(r, "B").Style = "Currency"
End If
'Increment row
r = r + 1
Loop
End Sub
Try the following:
Sub calcColumnB()
Dim strLength As Integer
Dim i As Long
For i = 1 To Rows.Count
columnAContents = Cells(i, 1).Value
strLength = Len(columnAContents)
If strLength > 0 Then
Cells(i, 2).NumberFormat = "$#,##0.00"
End If
Next i
End Sub
Explanation--
What the above code does is for each cell in Column B, so long as content in column A is not empty, it sets the format to a currency with 2 decimal places
EDIT:
Did not need to loop
Here's a really simply one, that I tried to comment - but the formatting got messed up. It simply reads column 1 (A) for content. If column 1 (A) is not empty it updates column 2 (B) as a currency. Changing active cells makes VBA more complicated than it needs to be (in my opinion)
Sub LoopTest()
Dim row As Integer
row = 1
While Not IsEmpty(Cells(row, 1))
Cells(row, 2).Style = "Currency"
row = row + 1
Wend
End Sub

Propagate values in excel cell

I need to propagate cell values to a row, it's sort of difficult to explain...
I have a cell which is always going to be populated with binary values, for example "01110011"
the number changes according to other formulas.
what I need to do is take similar adjacent values and populate a raw with them...
a picture is worth a thousand words I suppose...
http://s28.postimg.org/mf42j9ftp/223.jpg
So basically I need to take the A1 cell and split it across a row...
and I have no idea what so ever how it's done.
I think you will find the LEFT, RIGHT, and MID functions useful. If you were to put all the values that you need to split, like 01110011 (the binary string you used as an example), in column A, you could split it in columns B, C, D and E with the following formulas:
Column B:
=LEFT($A1,1)
Column C:
=MID($A1,2,3)
Column D:
=MID($A1,5,2)
Column E:
=RIGHT($A1,2)
The LEFT function takes a cell as the first argument and the number of characters you want from that cell starting with the leftmost character. The RIGHT function does the same but from the rightmost character. The MID function takes the cell as the first argument, the index of the character you wish to begin from as the second argument, and the number of characters you wish to return as the third argument.
This should help you
Sub splitCell()
Dim cellContent As String
Dim partOfCell As String
Dim columnCounter As Integer
'just to be sure set row format as text to support 00
Rows(2).ClearContents
Rows(2).NumberFormat = "#"
cellContent = CStr(Cells(1, 1))
columnCounter = 1
If Len(cellContent) > 0 Then
partOfCell = Mid(cellContent, 1, 1)
End If
For i = 2 To Len(cellContent)
If Mid(cellContent, i, 1) = Mid(partOfCell, 1, 1) Then
partOfCell = partOfCell + Mid(cellContent, i, 1)
Else
Cells(2, columnCounter) = partOfCell
partOfCell = Mid(cellContent, i, 1)
columnCounter = columnCounter + 1
End If
Next i
Cells(2, columnCounter) = partOfCell
End Sub
Try this option as well,
Sub ListStringIntoB()
'Loop through string, list characters into Starting B1 and over
Dim str As String, Cnt As Integer, A1 As Range, Lp As Integer
Dim col As Long, Rng As Range, r As Range
Set A1 = Range("A1")
str = A1
Cnt = Len(A1)
For Lp = 1 To Cnt
col = Cells(1, Columns.Count).End(xlToLeft).Column + 1
Set Rng = Cells(1, col)
Rng = Mid(str, Lp, 1)
Next Lp
End Sub
Thank you guys for trying to help, I finally found the answer to my predicament... I had to use this code to do the trick..
Sub SplitBinaryNumbers()
Dim Bin As Variant
Bin = Application.Transpose(Split(Replace(Replace(Range("A8").Value, "01", "0,1"), "10", "1,0"), ","))
With Range("A20").Resize(UBound(Bin))
.NumberFormat = "#"
.Cells = Bin
End With
End Sub
I hope this helps someone.

How to run an equation along whole column in excel vba

I want to run an excel vba which will go down column E and upon finding the value = "capa" will go two cell below, calculate the hex2dec value of that cell, present it by the cell with the value "capa" in column F and continue to search down column E.
So far I've came with the below but it doesn't work:
For Each cell In Range("E:E")
If cell.Value = "Capa" Then
ActiveCell.Offset.FormulaR1C1 = "=HEX2DEC(R[2]C[-1])"
End If
Next cell
Thanks!
How about something like this?
This will search volumn E for "Capa" and, if found, will place formula in column F using the value directly below "Capa" in column E
Sub CapaSearch()
Dim cl As Range
For Each cl In Range("E:E")
If cl.Value = "Capa" Then
cl.Offset(0, 1).Formula = "=HEX2DEC(" & cl.Offset(1, 0) & ")"
End If
Next cl
End Sub
You really want to limit the loop so you don't loop over the whole sheet (1,000,000+ rows in Excel 2007+)
Also, copying the source data to a variant array will speed things up too.
Try this
Sub Demo()
Dim dat As Variant
Dim i As Long
With ActiveSheet.UsedRange
dat = .Value
For i = 1 To UBound(dat, 1)
If dat(i, 6 - .Column) = "Capa" Then
.Cells(i, 7 - .Column).FormulaR1C1 = "=HEX2DEC(R[2]C[-1])"
End If
Next
End With
End Sub

Resources