What I am trying to do is simple but I just can't get it to work. I want select a range of cells and the run a macro that will:
Run a for loop from the first row to the last row on the range selected
Then return the "=NUMBERVALUE()" of the concatenated values in each column of the row
The output column will be right next to the last column of the selected range
This is what I have for the code:
Dim myRange As Range
Set myRange = Selection
First_Col = myRange.Column
Last_Row = myRange.Rows.Count + myRange.Row - 1
Last_Col = myRange.Column + myRange.Columns.Count - 1
Out_put_Col = Last_Col + 1
For i = myRange.Row To Last_Row
Cells(i, Out_put_Col) = "=NUMBERVALUE(Cells(i, First_Col) & Cells(i, First_Col+1)"
Next i
VBA is having issues with what is written in the for loop. I am newer to VBA but based on the way this is written I would have though it would work. Thanks for the help.
more like:
For i = myRange.Row To Last_Row
Cells(i, Out_put_Col) = "=NUMBERVALUE(" & Cells(i, First_Col).address & ":" & _
Cells(i, First_Col+1).address & ")"
Next i
I'm not sure NumberValue works like that though.
Related
I am new and learning Excel VBA. I am now having this problem
There is more than 10 tables in a worksheet (number of tables is not consistent)
The number of columns are consistent but not the rows in each tables
I would like to apply a total row to the end of every table
After that, I will apply the same formula to every table and put the results on the right side of each table
This could be easy but the core problem is that the range is unknown.
- As it is not an actual table in Excel, so I tried to first define the range of the data by creating table for it, then again, I don't have idea on how to create the table without knowing the range.
Below is something I came up with (which is not very "dynamic")
Sub plsWork()
Set u = ThisWorkbook.Worksheets("Sheet2")
Set f = u.Range("A").Find(what:="Name", lookat:=xlPart)
a = f.Address
Set sht = u.Range(a)
'trying to insert this at the end of the table
Total = Sum(u.Offset(2, 1) + u.Offset(3, 1) + u.Offset(4, 1))
If Cells(i, 2) = vbNullString Then 'this is already not applicable as the top 2 row in colB has null string
u.Offset(i, 1).Value = Total
'putting the table name at F2
u.Offset(-2, 5).Value = u.Offset(-3, 0).Value
u.Offset(-2, 6).Value = Total
u.Offset(-1, 5).Value = u.Offset(2, 0).Value
u.Offset(-1, 6).Value = Sum(u.Offset(2, 1) + u.Offset(2, 2) + u.Offset(2, 3))
u.Offset(0, 5).Value = u.Offset(3, 0).Value
u.Offset(0, 6).Value = Sum(u.Offset(3, 1) + u.Offset(3, 2) + u.Offset(3, 3))
u.Offset(1, 5).Value = u.Offset(4, 0).Value
u.Offset(1, 6).Value = Sum(u.Offset(4, 1) + u.Offset(4, 2) + u.Offset(4, 3))
End Sub
Oh, and when I run above code, I got error "Sub or Function not defined" on "SUM"
Here is the image of the tables in a sheet
yellow highlighted is what going to be there after executing the sub.
It was quite easy applying formula in Excel sheet and copy paste the formula to each tables,
but it was tedious, so I try to come out with a vba code to help so that the macro could run based on schedule.
I'm scratching my head and searching to and fro for the past two days,
I still haven't got a clue on how to code this.
So can any expert tell me if this is possible? like without knowing the range?
If so, could you guys shed me with some info on how to achieve this?
Thank you. I really want to know if this can be done or not.
Here is an image of my attempt using provided answer
You may try something like this...
The code below will insert a Total Row for each table which has more than one row and four columns in it.
Sub InsertTotalInEachTable()
Dim ws As Worksheet
Dim rng As Range
Dim i As Integer, r As Long, j As Long
Application.ScreenUpdating = False
Set ws = ActiveSheet
For Each rng In ws.UsedRange.SpecialCells(xlCellTypeConstants, 3).Areas
If rng.Rows.Count > 1 And rng.Columns.Count = 4 Then
j = 2
r = rng.Cells(rng.Rows.Count, 1).Row + 1
Cells(r, rng.Columns(1).Column).Value = "Total"
For i = rng.Columns(2).Column To rng.Columns(2).Column + 2
Cells(r, i).Formula = "=SUM(" & rng.Columns(j).Address & ")"
j = j + 1
Next i
End If
Next rng
Application.ScreenUpdating = True
End Sub
I have a small macro which takes data from multiple xml files and pastes in xlsm. Each xml file has a tag name, and the column the data pastes into has the tag name in row 4. I'm trying to paste into one below the last used row, but the three methods I have below keep returning "1" for the last used row.
Asterisks is the code I'm having trouble with.
For Z = 1 To 16
If Cells(4, Z).Value Like i Then
Dim Lengthend As Double
Dim An As Variant
An = (Split(Cells(4, Z).Address(True, False), "$")(0))
Lengthend = *****
Cells(Lengthend + 1, Z).Select
Cells(Lengthend + 1, Z).PasteSpecial Paste:=xlPasteValues
End If
Next
Here are the three methods I used to find the end of the column:
Dim sht As Worksheet
Set sht = Sheets("PI Data")
sht.Cells(sht.Rows.Count, "An").End(xlUp).Row
And
Lengthend = Range("An" & Rows.Count).End(xlUp).Row
And
(ActiveSheet.UsedRange.Columns(An).Count)
Each of these methods returns the answer "1." Any advice on what I'm doing wrong?
Lengthend = Range("An" & Rows.Count).End(xlUp).Row
The above has a typo and works if you change it to - what you propably tried to do is pass the value of variable An and not value "An"
Lengthend = Range(An & Rows.Count).End(xlUp).Row
You should also define the worksheet you are referring to to avoid any further problems -
Lengthend = Sheets("PI Data").Range(An & Rows.Count).End(xlUp).Row
Sorry I am new to VBA. The Vlookup calls for Column X & Y work fine. However, for column Z, I am trying to count the number of names in Column B, but an error kept popping up. I wonder why?
Dim lastrow As Long
lastrow = Range("A2").End(xlDown).Row
Range("X2:X" & lastrow).FormulaR1C1 = "=VLOOKUP(RC[-23],'Sheet2'!R1C1:R25000C10,7,0)"
Range("Y2:Y" & lastrow).FormulaR1C1 = "=VLOOKUP(RC[-24],'Sheet2'!R1C1:R25000C10,2,0)"
Range("Z2:Z" & lastrow).FormulaR1C1 = "=LEN(RC[-22]-LEN(SUBSTITUTE(RC[-22], "";"", ""))+1"
Columns("X:Z").EntireColumn.AutoFit
Basically, what I am try to achieve is like the following. Column Z will autofill the occurrences of names in column B
I think you are missing a parenthese in your function string, as well as escape quotes for the empty string, so it should be:
Range("Z2:Z" & lastrow).FormulaR1C1 = "=LEN(RC[-22])-LEN(SUBSTITUTE(RC[-22], "";"", """"))+1"
I realize that this answer doesn't answer your question but at least the following code serve the same purpose. And to fix the problem if there are blanks or merged cells in the range as pointed out by Mr. RGA, I change the way to formulate variable Last_Row
Sub Count_Name()
Dim i As Long, Last_Row As Long
With Sheets("Sheet1")
'It won't be a problem anymore if there are blanks or merged cells in the range using this line
Last_Row = Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To Last_Row
If .Cells(i, "A") = "" Then
.Cells(i, "B") = 0
Else
.Cells(i, "B") = Len(.Cells(i, "A")) - Len(Replace(.Cells(i, "A"), ";", "")) + 1
End If
Next i
End With
End Sub
Here I'm assuming the string names are in column A, the number of names are in column B, and both of the data are in Sheet1. The equivalent Excel formula for the above code is
=LEN(A2) - LEN(SUBSTITUTE(A2, ";", "")) + 1
So I'm hoping for some help to automate a process that will otherwise involve copying and editing some 10,000 rows.
This is stuff relating to location data. Essentially, there are tons of these Master Rows but they do not have individual rows for Unit Numbers. I am hoping to get something to expand these into individual Unit Number rows based on what is in Column N. Column N is intended to follow a strict format of being a comma-seperated single cell list for each row.
Below is an example from Sheet 1 of what each row will have and needs to be expanded upon. Note that Column N is green and follows a consistent formatting and this will be the determinant for how many times these rows will each be expanded upon.
Below is Sheet 2 and what I want the VBA to create from Sheet 1. You can see that each row has been expanded based on the contents of Column N from Sheet 1.
Like I said, it is expected that this will involve some several thousand rows to create.
Option Explicit
Sub Tester()
Dim sht1, sht2, rwSrc As Range, rwDest As Range, v, arr, n
Set sht1 = ThisWorkbook.Sheets("Sheet1")
Set sht2 = ThisWorkbook.Sheets("Sheet2")
sht2.Range("A2:M2").Resize(3, 13).Value = sht1.Range("A2:M2").Value
Set rwDest = sht2.Range("A2:M2") 'destination start row
Set rwSrc = sht1.Range("A2:M2") 'source row
Do While Application.CountA(rwSrc) > 0
v = rwSrc.EntireRow.Cells(1, "N").Value 'list of values
If InStr(v, ",") > 0 Then
'list of values: split and count
arr = Split(v, ",")
n = UBound(arr) + 1
Else
'one or no value
arr = Array(v)
n = 1
End If
'duplicate source row as required
rwDest.Resize(n, 13).Value = rwSrc.Value
'copy over the unit values
rwDest.Cells(1, "G").Resize(n, 1).Value = Application.Transpose(arr)
'offset to next destination row
Set rwDest = rwDest.Offset(n, 0)
'next source row
Set rwSrc = rwSrc.Offset(1, 0)
Loop
End Sub
This does the work in same sheet... Pls copy the value to "Sheet2" before executing this. Not sure about efficiency though.
Public Sub Test()
Dim lr As Long ' To store the last row of the data range
Dim counter As Long
Dim Str As String ' To store the string in column N
lr = Range("N65536").End(xlUp).Row 'Getting the last row of the data
For i = lr To 2 Step -1
Str = Range("N" & i).Value ' Getting the value from Column N
counter = 1
For Each s In Split(Str, ",")
If counter > 1 Then
Range("A" & (i + counter - 1)).EntireRow.Insert ' Inserting rows for each value in column N
Range("G" & (i + counter - 1)).Formula = s ' Updating the value in Column G
Else
Range("G" & i).Formula = s ' No need to insert a new row for first value
End If
counter = counter + 1
Next s
Next i
lr = Range("G65536").End(xlUp).Row
' Pulling down other values from the first value row other rows
Range("A1:N" & lr).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
' Pasting the data as Values to avoid future formula issues.
Range("A1:N" & lr).Copy
Range("A1:N" & lr).PasteSpecial xlPasteValues
MsgBox "Done"
End Sub
I'm using VBA in Excel and I'm using a function to find the first empty row then adding some values, after that I need to pass the address of the cell to another function but using the code below I get a runtime error. firstEmptyRow is a function that returns a range,e.g. $A$280.
Dim addCell as Range
'Find first empty row in the table
With firstEmptyRow
'Enter Values
.Value = taskID
.Offset(0, 1).Value = jobID
.Offset(0, 2).Value = jobName
.Offset(0, 6).Value = taskTypeID
.Offset(0, 8).Value = taskName
.Offset(0, 9).Value = desc
.Offset(0, 11).Value = estMins
.Offset(0, 13).Value = "No"
set addCell = .Address //Gives a runtime error
End With
What is the correct way to save the address of the cell so I can pass it to another function? Below is the code for firstEmptyRow
Public Function firstEmptyRow() As Range 'Returns the first empty row in the Schedule sheet
Dim i, time As Long
Dim r As Range
Dim coltoSearch, lastRow As String
Dim sheet As Worksheet
Set sheet = Worksheets("Schedule")
time = GetTickCount
coltoSearch = "A"
For i = 3 To sheet.Range(coltoSearch & Rows.Count).End(xlUp).Row
Set r = sheet.Range(coltoSearch & i)
If Len(r.Value) = 0 Then
Set firstEmptyRow = sheet.Range(r.Address)
'r.Select
Exit For 'End the loop once the first empty row is found
End If
Next i
'Debug.Print "firstEmptyRow time: " & GetTickCount - time, , "ms"
End Function
The .Address property returns a string so you'll need to to set the addCell variable like so:
Set addCell = Worksheets("Schedule").Range(.Address)
I am a total "noob" at vba and learning by trying code snipits and routines that appear to to me to answer to a problem I am stuck on. When I tried the code posted by Vityata I encountered "Run-time error '424': Object Required
at the following stmts:
Set myCell = Sheet.Range(coltoSearch & i)
Set FirstEmptyRow = Sheet.Range(coltoSearch & i + 1)
Changing the stmts as follows resolved the errors for me:
Set myCell = wks.Range(coltoSearch & i)
Set FirstEmptyRow = wks.Range(coltoSearch & i + 1)
I also added a Debug.Print stmt between the last End If and the End Function stmts so I could quickly see the result when testing as follows:
End If
Debug.Print "The 1st empty cell address is "; coltoSearch & i
End Function
If I have violated some posting rule, please accept my apology. Hopefully sharing this will avoid future confusion by others who use a similar learning process.
You do not need to overcomplicate the code with something like Set addCell = Worksheets("Schedule").Range(.Address) because it really makes the readability a bit tough. In general, try something as simple as this: Set FirstEmptyRow = myCell. Then the whole code could be rewritten to this:
Public Function FirstEmptyRow() As Range
Dim myCell As Range
Dim coltoSearch As String, lastRow As String
Dim wks As Worksheet
Set wks = Worksheets(1)
coltoSearch = "A"
Dim i As Long
For i = 3 To wks.Range(coltoSearch & Rows.Count).End(xlUp).Row
Set myCell = sheet.Range(coltoSearch & i)
If IsEmpty(myCell) Then
Set FirstEmptyRow = myCell
Exit For
End If
Next i
If i = 2 ^ 20 Then
MsgBox "No empty rows at all!"
Else
Set FirstEmptyRow = sheet.Range(coltoSearch & i + 1)
End If
End Function
The last part of the code makes sure, that if there is no empty cell before the last row and row number 3, then next cell would be given as an answer. Furthermore, it checks whether this next row is not the last row in Excel and if it is so, it gives a MsgBox() with some information.