Excel Loop Column A action column B - excel

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

Related

How to use Rows.Count function if there are blank cells in between data

I am trying to write a code that adds in data from my excel sheet if the item the user selects is equal to the range in J. This works perfectly if the range in J is filled in with all the data, but how do I get the row to still count all the way through the last filled cell if there are blanks in between? I attached a picture to show what I mean.
.
I would want to count the rows all the way down to the last "Gold". Right now it only counts to the second.
Private Sub cboName_Click() 'only get values that are assigned
Dim j As Integer, k As Integer, i As Integer
Me.lstProvider.Clear
i = 0
Worksheets("Biopsy Log").Select
For j = 1 To Range("J2", Range("J1").End(xlDown)).Rows.count
If Range("J2", Range("J2").End(xlDown)).Cells(j) = Me.cboName.Value Then
If Range("C2", Range("C2").End(xlDown)).Cells(j) = "Assigned" Then
With Me.lstProvider
.AddItem
For k = 0 To 5
.List(i, k) = Range("A" & j + 1).Offset(0, k)
Next
End With
i = i + 1
End If
End If
Next
End Sub
Instead of For j = 1 To Range("J2", Range("J1").End(xlDown)).Rows.count use Range("J" & Rows.Count).End(xlUp).Row (assuming GOLD is in column J). The code does the opposite of xlDown. It goes down to the last row of the sheet (Rows.count) and moves up until it find the first non-blank cell.
Instead of using xlDown, try to use xlUp from the bottom to get the last row for correct range:
Dim sht As Worksheet
Set sht = Worksheets("Biopsy Log")
For j = 1 To sht.Range("J" & sht.Rows.Count).End(xlUp).Row
If sht.Range(...)
Qualifying Range calls with an explicit Worksheet object makes your code more robust.

VBA code to divide cells if reference cell contain a text

I need to get a VBA code to excel for following criteria.
If any cell in the range of B1 to B500 contains "TOTAL:", divide same row value in column V with same row value in Column P where "TOTAL:" text exists.
Answer should be in same row column M.
I tried to develop the code like this:
Sub test()
Dim r As Range
For Each r In Range("B1", Range("B" & Rows.Count).End(xlUp))
If r.Value Like "TOTAL:" Then
With Range("M1:M10")
r.Formula = "=V5/P1"
End With
End If
Next
End Sub
If you want to learn VBA, I'd recommend you to solve those problems on your own by searching for 'loop through range' and 'compare string' and so on. That would be much more valuable for you on a long-term.
Anyway, for now you can try this. Please note that it doesn't provide any error handling etc...
Search Range:
For row = 1 To Cells(ws.Rows.Count, "B").End(xlUp).row loops through the rows from 1 to the last row with a value in column B. If you, for some reason, want to exclude just that very last row and stop at the second last, just substract 1 from it. If you seriously want a fixed range, change the whole thing to For row = 1 To 500.
Sub test()
Dim ws As Worksheet
Dim row As Long
Set ws = Sheet1 'insert name of sheet
For row = 1 To Cells(ws.Rows.Count, "B").End(xlUp).row
If StrComp(Cells(row, 2).Value, "TOTAL:", vbTextCompare) = 0 Then
Cells(row, 13).Value = Cells(row, 22).Value / Cells(row, 16).Value
End If
Next row
End Sub

Delete rows if cell contains certain text

I want to delete the entire rows for cell that contain 'Total' and 'Nett' in column C.
I have tried the macro recording using Auto Filter but it only delete rows up to a specified range (which may differ if I use other set of data).
Appreciate your help!
Here you go. Just copy and paste this sub into your file. To use it, select the SINGLE column that you want to evaluate. This will go through every cell that has been selected, and if it matches the criteria, it will delete the entire row. Let me know if you have any questions. Good luck!
Sub DeleteRows()
'Enter the text you want to use for your criteria
Const DELETE_CRITERIA = "Test"
Dim myCell As Range
Dim numRows As Long, Counter As Long, r As Long
'Make sure that we've only selected a single column
If Selection.Columns.Count > 1 Then
MsgBox ("This only works for a single row or a single column. Try again.")
Exit Sub
End If
numRows = Selection.Rows.Count - 1
ReDim arrCells(0 To 1, 0 To numRows) As Variant
'Store data in array for ease of knowing what to delete
Counter = 0
For Each myCell In Selection
arrCells(0, Counter) = myCell
arrCells(1, Counter) = myCell.Row
Counter = Counter + 1
Next myCell
'Loop backwards through array and delete row as you go
For r = numRows To 0 Step -1
If InStr(1, UCase(arrCells(0, r)), UCase(DELETE_CRITERIA)) > 0 Then
Rows(arrCells(1, r)).EntireRow.Delete
End If
Next r
End Sub
This will loop through cells in Column C and delete the entire row if the cell contains either "Total" or "Nett". Keep in mind that it is case sensitive, so the first letter of "Nett" or "Total" would need to be capitalized for this to find it. There can be other text in the cell however. Also note that the references are not fully qualified (ie Workbook().Worksheet().Range()) because you did not provide a workbook or worksheet name. Let me know if this does not work for you.
Sub Delete()
Dim i as Integer
For i = Range("c" & Rows.Count).End(xlUp).Row To 1 Step -1
If Instr(1, Cells(i, 3), "Total") <> 0 Or Instr(1, Cells(i,3),"Nett") <> 0 Then
Cells(i,3).EntireRow.Delete
End If
Next i
End Sub

How to delete a row if it contains a string?

I have only one column of data. I need to write a macro that would go through all the values and delete all rows that contain the word "paper".
A B
1 678
2 paper
3 3
4 09
5 89
6 paper
The problem is that the number of rows is not fixed. Sheets may have different number of rows.
Here is another simple macro that will remove all rows with non-numeric values in column A (besides row 1).
Sub DeleteRowsWithStringsInColumnA()
Dim i As Long
With ActiveSheet '<~~ Or whatever sheet you may want to use the code for
For i = .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1).Row To 2 Step -1 '<~~ To row 2 keeps the header
If IsNumeric(.Cells(i, 1).Value) = False Then .Cells(i, 1).EntireRow.Delete
Next i
End With
End Sub
If you're confident that the rows in question would always contain "paper" specifically and never any other string, you should match based on the value paper rather than it being a string. This is because, particularly in Excel, sometimes you may have numbers stored as strings without realizing it--and you don't want to delete those rows.
Sub DeleteRowsWithPaper()
Dim a As Integer
a = 1
Do While Cells(a, 1) <> ""
If Cells(a, 1) = "paper" Then
Rows(a).Delete Shift:=xlUp
'Row counter should not be incremented if row was just deleted
Else
'Increment a for next row only if row not deleted
a = a + 1
End If
Loop
End Sub
The following is a flexible macro that allows you to input a string or number to find and delete its respective row. It is able to process 1.04 million rows of simple strings and numbers in 2.7 seconds.
Sub DeleteRows()
Dim Wsht As Worksheet
Dim LRow, Iter As Long
Dim Var As Variant
Var = InputBox("Please specify value to find and delete.")
Set Wsht = ThisWorkbook.ActiveSheet
LRow = Wsht.Cells(Rows.Count, 1).End(xlUp).Row
StartTime = Timer
Application.ScreenUpdating = False
With Wsht
For Iter = LRow To 1 Step -1
If InStr(.Cells(Iter, 1), Var) > 0 Then
.Cells(Iter, 1).EntireRow.Delete
End If
Next Iter
End With
Application.ScreenUpdating = True
Debug.Print Timer - StartTime
End Sub

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