Row Number reference with VBA - vba

I have searched a bit for a VBA code that will list me a row reference and am not finding results. Perhaps I am missing what the actual term for it is?
I have a list of names in Column A, starting at A2. Then what I would like is a listing of 1,2,3,4,5 going down Column B, starting from B2, until the names stop.
I can do this as a formula but need to have the values set there by a macro in this case.
Can this be done?

If I understand you correctly then this should work:
Sub test()
Dim lastRow As Long, counter As Long
Dim cell As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("NAME_OF_YOUR_WORKSHEET")
lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
counter = 1
For Each cell In ws.Range("B2:B" & lastRow)
cell.Value = counter
counter = counter + 1
Next cell
End Sub

No need for a loop:
Sub NumberRows()
With Sheets("Sheet Name Here")
With .Range("B2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row)
.Formula = "=ROW()-1"
.Value = .Value
End With
End With
End Sub

Related

Looping and finding similar number in VBA

I am very new to VBA. Just started reading it up 2 days ago. I am wondering how could I write a VB codes assigned to a button to read through the whole column and search for similar numbers.
After that identifying similar numbers, it would need to move on to another column to check if the character in the column are same too.
If both of the logic = true . How can i change the cell of the value of another column?
Sample data
For the current example. The code should know that the first column had matching numbers. After that it will check for the name which is "a" in the example. After that it will automatically change the point to 1 and 0. If there are 3 same ones it will be 1,0,0 for the point
You may try recording whatever you want to do with record macros first, then filter out the codes that are not necessary. If you do not know how to record it using macros, click on the link below. You can learn from the recorded macros and slowly improvise your codes in the future from the experience you may gain.
Here's [a link] (http://www.dummies.com/software/microsoft-office/excel/how-to-record-a-macro-in-excel-2016/)
As per image attached in image I am assuming numbers are in Column A, column to check characters is Column J and result needs to be displayed in Column O then try following code.
Sub Demo()
Dim dict1 As Object
Dim ws As Worksheet
Dim cel As Range, fCell As Range
Dim lastRow As Long, temp As Long
Dim c1
Set dict1 = CreateObject("Scripting.Dictionary")
Set ws = ThisWorkbook.Sheets("Sheet2") 'change Sheet2 to your data sheet
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'last row with data in Column A
c1 = .Range("A2:A" & lastRow)
For i = UBound(c1, 1) To 1 Step -1 'enter unique values with corresponding values in dict1
dict1(c1(i, 1)) = .Range("J" & i + 1) '+1 for Row 2
Next i
Set fCell = .Range("A2")
For Each cel In .Range("A2:A" & lastRow) 'loop through each cell in Column A
temp = WorksheetFunction.CountIf(.Range(fCell, cel.Address), cel) 'get count
If temp > 1 Then
If cel.Offset(0, 9) = dict1(cel.Value) Then
cel.Offset(0, 14).Value = 0
Else
cel.Offset(0, 14).Value = 1
End If
Else
cel.Offset(0, 14).Value = 1
End If
Next cel
End With
End Sub
EDIT
Sub Demo()
Dim ws As Worksheet
Dim lastRow As Long
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Sheet2") 'change Sheet3 to your data range
With ws
lastRow = .Cells(.Rows.count, "A").End(xlUp).Row 'last row with data in Column A
.Range("O2").Formula = "=IF(MOD(SUMPRODUCT(($A$2:$A2=A2)*($J$2:$J2=J2)),3)=1,1,0)" 'enter formula in Cell O2
.Range("O2").AutoFill Destination:=.Range("O2:O" & lastRow) 'drag formula down
.Range("O2:O" & lastRow).Value = .Range("O2:O" & lastRow).Value 'keep only values
End With
Application.ScreenUpdating = True
End Sub

How to pick value based on condition in macros

I want to compare the data so I have to pick a value based on a condition. The example data that I have is like:
The condition is:
I want to pick the value of PO NO. that always placed 2 column after text "PO NO."
How do I get that value? After that copy and paste it in another column (example:column A)
It depends on how do you want to use those values, if you just want to put them into some continued ranges in current workbook, then I think the Filter function is sufficient, if you want to do some further calculation, you may want to write some VBA code:
Press ALT + F11 in your current worksheet.
Press ALT + I then press M.
Press Ctrl + G to open the "Immediate" window
Then write the following lines:
Sub myValues()
Dim rCount As Long
Dim i As Long
Let rCount = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row
For i = 1 to rCount
If WorksheetFunction.Trim(ThisWorkbook.ActiveSheet.Cells(i,6).Text) = "PO No." Then
Debug.Print ThisWorkbook.ActiveSheet.Cells(i,8).Text
End If
Next
End Sub
Now you could get all the PO NO values in the "Immediate" window.
You can extract the value you want using this formula.
=INDEX(F44:H49,MATCH("PO No.",F44:F49,0),3)
The problem which remains to be solved is how to define the range F44:F49. Your question delivers no hint as to how that should be done. Perhaps knowing where you want to value to appear would offer a clue.
You can iterate over each cell in the column and gather your post numbers, offsetted by 2 columns, like I mentioned in comments
Sub Test()
Dim WS As Worksheet
Dim ParamRange As Range
Dim LastRow As Long
Dim Cell As Range
Dim i As Long
Set WS = ActiveSheet 'or whatever sheet your want
With WS
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
Set ParamRange = .Range("F1:F" & LastRow)
End With
For Each Cell In ParamRange 'iterate over column
If Cell.Value2 = "PO NO." Then
i = i + 1
'Debug.Print to Immediate
Debug.Print i, CurrentSearch.Offset(ColumnOffset:=2).Value2
'Paste in "A" column
CurrentSearch.Offset(ColumnOffset:=-5).Value2 = CurrentSearch.Offset(ColumnOffset:=2).Value2
End If
Next
End Sub
So you just need to collect all Cell.Offset(ColumnOffset:=2).Value2 values.
Alternatively, without iteration over cells (and faster), but little bit complicated:
Sub Test()
Dim WS As Worksheet
Dim ParamRange As Range
Dim CurrentSearch As Range
Dim FirstSearch As Range
Dim LastRow As Long
Dim Cell As Range
Dim i As Long
Set WS = ActiveSheet 'or whatever sheet your want
With WS
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
Set ParamRange = .Range("F1:F" & LastRow)
End With
'Get first search
Set CurrentSearch = ParamRange.Find(What:="PO NO.", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not CurrentSearch Is Nothing Then
i = i + 1
'Debug.Print to Immediate
Debug.Print i, CurrentSearch.Offset(ColumnOffset:=2).Value2
'Paste in "A" column
CurrentSearch.Offset(ColumnOffset:=-5).Value2 = CurrentSearch.Offset(ColumnOffset:=2).Value2
Set FirstSearch = CurrentSearch
Do
'Get next search
Set CurrentSearch = ParamRange.FindNext(After:=CurrentSearch)
If Not CurrentSearch Is Nothing Then
If CurrentSearch.Address = FirstSearch.Address Then Exit Do
i = i + 1
'Debug.Print to Immediate
Debug.Print i, CurrentSearch.Offset(ColumnOffset:=2).Value2
'Paste in "A" column
CurrentSearch.Offset(ColumnOffset:=-5).Value2 = CurrentSearch.Offset(ColumnOffset:=2).Value2
Else
Exit Do
End If
Loop
End If
End Sub
Links:
Range.Offset
Find last row, column or last cell
.Find and .FindNext in Excel VBA

using a formula in vba to compare cells and enter results in another cell

I going to use a formula in VBA to compare to columns of data and if a match is found then enter some data from one sheet to another. I have used a formula on the first row and this works I get the desired results, I want to automate it as this will be part of other automations on the report. I have got some code which enters a column heading then applies the sumif function to the entire column but I get the same results all the way down, it is the results for the first row.
Code
Sub ImportCosting()
Dim z As Workbook
Dim x As Workbook
Set x = Workbooks.Open("C:\Documents\Reports\MEP.xlsx")
With Workbooks("MEP")
Worksheets("DynamicReport").Range("P5").Value = "Budget"
Worksheets("DynamicReport").Range("Q5").Value = "Forecast"
End With
Set z = Workbooks.Open("C:\Documents\Reports\Budget.xlsx")
With x.Worksheets("DynamicReport")
lastRow = .Cells(Rows.Count, 5).End(xlUp).Row
For Each rng In .Range("P6:P" & lastRow)
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$B6,'[Budget.xlsx]DynamicReport'!H:H)"
rng.Value = rng.Value
Next rng
End With
End sub
Hope I have explained the problem correctly. Can anyone tell me where I have gone wrong and how to get it so that the sumif function is applied to each row and not the results for the first row repeated.
Thanks
I am not sure but I guess you want to change the B6 to the rng.row
I guess you are getting the same result in every cell of rng because you are putting B6 as the criteria for sum so change that to the corresponding row number in the B column so that you get the desired result.
Change this:
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$B6,'[Budget.xlsx]DynamicReport'!H:H)"
to this
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$B" & rng.Row & ",'[Budget.xlsx]DynamicReport'!H:H)"
pls try below
Sub ImportCosting()
Dim z As Workbook
Dim x As Workbook
Set x = Workbooks.Open("C:\Documents\Reports\MEP.xlsx")
With Workbooks("Bank.xlsx")
Worksheets("DynamicReport").Range("P5").Value = "Budget"
Worksheets("DynamicReport").Range("Q5").Value = "Forecast"
End With
Set z = Workbooks.Open("C:\Documents\Reports\Budget.xlsx")
With x.Worksheets("DynamicReport")
lastRow = .Cells(Rows.Count, 5).End(xlUp).Row '"E"
For Each Rng In .Range("P6:P" & lastRow)
Rng.Formula = "=SUMIF([Budget.xlsx]DynamicReport!$C:$C,[Budget.xlsx]DynamicReport!$B$" & Rng.Row & ",[Budget.xlsx]DynamicReport!H:H)"
'Rng.Value = Application.WorksheetFunction.SumIf(z.Worksheets("DynamicReport").Range("C:C"), z.Worksheets("DynamicReport").Range("B" & Rng.row), z.Worksheets("DynamicReport").Range("H:H"))
Rng.Value = Rng.Value
Next Rng
End With
End Sub

Reading Manipulating and Writing Data in VBA

If I have a column of values, how do I read the values into a variable in VBA, perform some operation on it and then write it to the next column? Seems mind numbingly simple but I haven't been able to find a simple guide.
for example:
Column A = 1, 4, 5, 7
without writing formulas into column B
Dim A, B
A = column a
B = log(A)
write the values of B to the next column.
Thanks!
If you want to loop through a whole sheet you can do it like this.
Dim lRow as long
Dim strA as string
Dim strB as string
Dim ws As Excel.Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
lRow = 1
Do While lRow <= ws.UsedRange.Rows.count
'Read the data from columnA
strA = ws.Range("A" & lRow).Value
'do something with the value you got from A
strB = strA & "some other text"
strB = log(strA)
'Write it to C
ws.Range("C" & lRow).Value = strB
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
Or if you just want a certain predefined row it would be more hard coded like this.
'Read the data from columnA
strA = ws.Range("A6").Value
'do something with the value you got from A
strB = strA & "some other text"
strB = log(strA)
'Write it to C
ws.Range("C6").Value = strB
Try this macro:
Sub test()
Dim cel As Range, rng As Range
Dim logCel As Double
Dim lastRow As Integer
lastRow = Cells(1048576, 1).End(xlUp).Row
Set rng = Range(Cells(1, 1), Cells(lastRow, 1)) 'Create a range to search
For Each cel In rng
If Not IsEmpty(cel) Then 'If the cell has a value in it
logCel = Log(cel) 'add the LOG of the value to a variable
cel.Offset(0, 1).Value = logCel 'In the cell to the right of the cell, put the log
End If
Next cel
End Sub
To learn about setting cell values and such, I highly recommend using the macro recorder, then looking through the macro when you're done. Start the recorder, then enter a value into a cell, then in the one next, enter a log of that one, and you'll get some idea of how VBA works.
Rather than looping through cell by cell you would write directly to the worksheet using a LOG formula (no need for an array as the manipulation can be used directly with inserting a formula):
Sub LikeThis()
Dim rng1 As Range
`work on A1:A20 and write to B1:B20
Set rng1 = [a1:a20]
rng1.Offset(0, 1).FormulaR1C1 = "=IF(RC[-1]>0,LOG(RC[-1]),""not valid"")"
End Sub

VBA - If a cell in column A is not blank the column B equals

I'm looking for some code that will look at Column A and as long as the cell in Column A is not blank, then the corresponding cell in Column B will equal a specific value.
So if Cell A1 <> "" then Cell B1.Value = "MyText"
And repeat until a cell in Column A is blank or empty.
To add a little more clarification, I have looked through the various loop questions asked and answered here. They were somewhat helpful. However, I'm unclear on how to get the loop to go through Column A to verify that each cell in Column A isn't blank AND in the corresponding cell in Column B, add some text that I specify.
Also, this will need to be part of a VBA macro and not part of a cell formula such as =IF
If you really want a vba solution you can loop through a range like this:
Sub Check()
Dim dat As Variant
Dim rng As Range
Dim i As Long
Set rng = Range("A1:A100")
dat = rng
For i = LBound(dat, 1) To UBound(dat, 1)
If dat(i, 1) <> "" Then
rng(i, 2).Value = "My Text"
End If
Next
End Sub
*EDIT*
Instead of using varients you can just loop through the range like this:
Sub Check()
Dim rng As Range
Dim i As Long
'Set the range in column A you want to loop through
Set rng = Range("A1:A100")
For Each cell In rng
'test if cell is empty
If cell.Value <> "" Then
'write to adjacent cell
cell.Offset(0, 1).Value = "My Text"
End If
Next
End Sub
Another way (Using Formulas in VBA). I guess this is the shortest VBA code as well?
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("B1:B" & lRow).Formula = "=If(A1<>"""",""My Text"","""")"
.Range("B1:B" & lRow).Value = .Range("B1:B" & lRow).Value
End With
End Sub
A simpler way to do this would be:
Sub populateB()
For Each Cel in Range("A1:A100")
If Cel.value <> "" Then Cel.Offset(0, 1).value = "Your Text"
Next
End Sub
Use the function IF :
=IF ( logical_test, value_if_true, value_if_false )