Passing a Variable to an Add-in Function in Excel VBA - vba

I want to write a for loop that takes the value of each cell, passes it into a function called FixID(), then outputs the result of the function into the value of the cell. The below code passes in values to the function fine, but it does not write the new value to the cell.
Sub test()
Total_Rows = Cells(Rows.Count, 3).End(xlUp).Row
For Each C In Range("A3", "C" & Total_Rows )
C = FixID(C.Value)
Next
End Sub

UPDATE: Here is a quick little example I put together to test the technique, and it worked as expected...
Option Explicit
Sub Test()
Dim MyRange As Range, Cell As Range
Dim Temp As String
Dim Total_Rows As Long
Total_Rows = Cells(Rows.Count, 3).End(xlUp).Row
Set MyRange = Range("A1:C" & Total_Rows)
For Each Cell In MyRange
Cell.Value = AddShrimp(Cell.Value)
Next Cell
End Sub
'Bubba Gump Function
Public Function AddShrimp(InputValue As String) As String
AddShrimp = InputValue & " Shrimp"
End Function
Before:
After:
ORIGINAL RESPONSE: Make sure you define the Range you're going to iterate through like this:
For Each C In Range("A3:C" & Total_Rows)
C.Value = FixID(C.Value)
Next C
I would probably add Option Explicit to the top of your routine as well, and declare all your variables up-front too (to prevent confusion, typo-related errors etc.):
Option Explicit
Sub Test()
Dim Total_Rows As Long
Dim C As Range, TotalRange As Range
Total_Rows = Cells(Rows.Count, 3).End(xlUp).Row
Set TotalRange = Range("A3:C" & Total_Rows)
For Each C In TotalRange
C.Value = FixID(C.Value)
Next C
End Sub

Related

Copy data from one sheet to another in reverse order using vba

I have two sheets in my excel PullData and AllStocks. I would like to copy data from PullData column A and paste the values reverse order into other sheet AllStocks.
Currently, I am using OFFSET function to perform it. But I see a performance issue while running large data set using this method. Is there any better way I can perform this task ?
My CUrrent Code :
Sub GetData()
Dim Main As Worksheet
Dim PullData As Worksheet
Dim AllStocks As Worksheet
Dim i,m As Integer
Set RawImport = Workbooks("vwap.xlsm").Sheets("RawImport")
Set PullData = Workbooks("vwap.xlsm").Sheets("PullData")
m = PullData.Cells(Rows.Count, "A").End(xlUp).Row
For i = 3 To m
AllStocks.Range("A2:A" & i).Formula = "=OFFSET(PullData!$A$" & m & ",-(ROW(PullData!A1)-1),0)"
Next i
End Sub
no loop code:
Option Explicit
Sub GetData()
Dim pullDataVals As Variant
With Workbooks("vwap.xlsm")
With .Sheets("PullData")
pullDataVals = Split(StrReverse(Join(Application.Transpose(.Range("A3", .Cells(.Rows.Count, "A").End(xlUp)).Value), ",")), ",")
End With
.Sheets("RawImport").Range("A2").Resize(UBound(pullDataVals) + 1).Value = Application.Transpose(pullDataVals)
End With
End Sub
just check your sheets names: in your question you're speaking about "PullData and AllStocks" but in your code some RawImport sheet is featuring...
or, in a super compressed style:
Sub GetData()
With Workbooks("vwap.xlsm").Sheets("PullData")
With .Range("A3", .Cells(.Rows.Count, "A").End(xlUp))
.Parent.Parent.Sheets("RawImport").Range("A2").Resize(.Rows.Count).Value = Application.Transpose(Split(StrReverse(Join(Application.Transpose(.Value), ",")), ","))
End With
End With
End Sub
should your data in PullData be a more than one character string or more than one digit number, to prevent what Gary's Student remarked, you could use ArrayList object and its Reverse method:
Sub GetData()
Dim arr As Object
Dim cell As Range
Set arr = CreateObject("System.Collections.Arraylist")
With Workbooks("vwap.xlsm")
With .Sheets("PullData")
For Each cell In .Range("A3", .Cells(.Rows.Count, "A").End(xlUp))
arr.Add cell.Value
Next
End With
arr.Reverse
.Sheets("RawImport").Range("A2").Resize(arr.Count) = Application.Transpose(arr.toarray)
End With
End Sub
This solution applies the INDEX formula to a temporary Name.
Sub Range_ReverseOrder()
Const kFml As String = "=INDEX(_Src,#RowsSrc+#RowTrg-ROW(),1)"
Dim nmSrc As Name, rgTrg As Range
Dim lRows As Long, sFml As String
Rem Set Objects
With Workbooks("vwap.xlsm")
lRows = .Worksheets("PullData").Cells(Rows.Count, 1).End(xlUp).Row
Set nmSrc = .Names.Add(Name:="_Src", _
RefersTo:=.Worksheets("PullData").Cells(2, 1).Resize(-1 + lRows, 1))
.Names("_Src").Comment = "Range_ReverseOrder"
Set rgTrg = .Worksheets("RawImport").Cells(2, 1).Resize(-1 + lRows, 1)
End With
Rem Set Formula
sFml = kFml
sFml = Replace(sFml, "#RowsSrc", nmSrc.RefersToRange.Rows.Count)
sFml = Replace(sFml, "#RowTrg", rgTrg.Row)
Rem Apply Formula
With rgTrg
.Offset(-1).Resize(1).Value = "Reverse.Order"
.Formula = sFml
.Value2 = .Value2
End With
Rem Delete Temporary Name
nmSrc.Delete
End Sub

VBA Writing IFERROR to Multiple Cells with For...Next Loop

I am trying to apply "=IFERROR" to a spreadsheet containing over 1000 rows of data. I already came up with a way to make the entries hard-coded. But is there a way to fill the cells with something like "=IFERROR(IFERROR(A1,B1),"")" rather than the value? Below is the hard-coded version:
Sub HardCodeIFERROR()
Dim a As Integer, xRecordCount1 As Integer
Set w(1) = Sheets("ABC")
xRecordCount1 = w(1).Cells(Rows.Count, 1).End(xlUp).Row
For a = 1 To xRecordCount1
w(1).Cells(a, 3).Value = Application.WorksheetFunction.IfError(Application.WorksheetFunction.IfError(Range("A" & a), Range("B" & a)), "")
Next a
Exit Sub
End Sub
Thank you in advance for your help!
You can instead just use .Formula:
w(1).Cells(a, 3).Formula = "=IFERROR(IFERROR(A" & a & ",B" & a & "),"""")"
Note you can skip the loop and just use a range:
Sub HardCodeIFERROR()
Dim ws1 As Worksheet
Dim a As Integer, xRecordCount1 As Integer
Set ws1 = Sheets("Sheet1")
xRecordCount1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
With ws1
.Range(.Cells(1, 3), .Cells(xRecordCount1, 3)).FormulaR1C1 = "=IFERROR(IFERROR(RC[-2],RC[-1]),"""")"
End With
End Sub
Note: Make sure to use the sheet with the Rows.Count whenever you use it, just like you do with Cells() and Range(). Also, I changed the sheet name because I wasn't sure if you intended to do a Sheet Array or not, so I used a more clear (IMO) variable name.
Just use the Formula property:
Sub HardCodeIFERROR()
Dim a As Integer, xRecordCount1 As Integer
'Need to declare the size of the array if you are going to assign worksheets to "w(1)"
Dim w(1 To 1) As Worksheet
Set w(1) = Sheets("ABC")
'Ensure you fully qualify "Rows.Count" by specifying which worksheet you are referring to
xRecordCount1 = w(1).Cells(w(1).Rows.Count, 1).End(xlUp).Row
'Apply formula to all cells
w(1).Range("C1:C" & xRecordCount1).Formula = "=IFERROR(IFERROR(S1,V1),"""")"
End Sub

excel vba convert string to range

I am trying to run a macro on 3 different ranges, one after another. Once the range is selected, the code works just fine (where variables F and L are defined). I would like to set r1-r3 as Ranges I need and then use a string variable to concatenate the range numbers together. This code works, but doesn't provide the starting and ending row number in the range selected. This is vital because it tells the "TableCalc" macro when to start and stop the code. I would then like to move on to the next range. Thanks for your help.
Sub TestRangeBC()
WS.Select
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim rngx As String
Dim num As Integer
Dim rng As Range
Set r1 = WS.Range("ONE")
Set r2 = WS.Range("TWO")
Set r3 = WS.Range("THREE")
For num = 1 To 3
rngx = "r" & num
Set rng = Range(rngx)
Dim F As Integer
Dim L As Integer
F = rng.Row + 1
L = rng.Row + rng.Rows.Count - 2
Cells(F, 8).Select
Do While Cells(F, 8) <> "" And ActiveCell.Row <= L
'INSERT SITUATIONAL MACRO
Call TableCalc
WS.Select
ActiveCell.Offset(1, 0).Select
Loop
Next num
End Sub
This is not the answer (as part of your code and what you are trying to achieve is unclear yet), but it is a "cleaner" and more efficient way to code what you have in your original post.
Option Explicit
Dim WS As Worksheet
Your original Sub shorten:
Sub TestRangeBC()
' chanhe WS to your Sheet name
Set WS = Sheets("Sheet1")
Call ActiveRange("ONE")
Call ActiveRange("TWO")
Call ActiveRange("THREE")
End Sub
This Sub gets the Name of the Named Range (you set in your workbook) as a String, and sets the Range accordingly.
Sub ActiveRange(RangeName As String)
Dim Rng As Range
Dim F As Integer
Dim L As Integer
Dim lRow As Long
With WS
Set Rng = .Range(RangeName)
' just for debug purpose >> to ensure the right Range was passed and set
Debug.Print Rng.Address
F = Rng.Row + 1
L = Rng.Row + Rng.Rows.Count - 2
lRow = F
' what you are trying to achieve in this loop is beyond me
Do While .Cells(F, 8) <> "" And .Cells(lRow, 8).Row <= L
Debug.Print .Cells(lRow, 8).Address
'INSERT SITUATIONAL MACRO
' Call TableCalc
' not sure you need to select WS sheet again
WS.Select
lRow = lRow + 1
Loop
End With
End Sub
What are you trying to test in the loop below, what are the criteria of staying in the loop ?
Do While Cells(F, 8) <> "" And ActiveCell.Row <= L
it's really hard to tell what you may want to do
but may be what follows can help you clarifying and (hopefully) doing it!
first off, you can't "combine" variable names
So I'd go with an array of named ranges names (i.e. String array) to be filled by means of a specific sub:
Function GetRanges() As String()
Dim ranges(1 To 3) As String
ranges(1) = "ONE"
ranges(2) = "TWO"
ranges(3) = "THREE"
GetRanges = ranges
End Function
so that you can clean up your "main" sub code and keep only more relevant code there:
Sub TestRangeBC()
Dim r As Variant
Dim ws As Worksheet
Set ws = Worksheets("Ranges") '<--| change "Ranges" to your actual worksheet name
For Each r In GetRanges() '<--| loop through all ranges names
DoIt ws, CStr(r) '<--| call the range name processing routine passing worksheet and its named range name
Next r
End Sub
the "main" sub loops through the named ranges array directly collected from GetRanges() and calls DoIt() to actually process the current one:
Sub DoIt(ws As Worksheet, rangeName As String)
Dim cell As Range
Dim iRow As Long
With ws.Range(rangeName) '<--| reference the passed name passed worksheet named range
For iRow = .Rows(2).Row To .Rows(.Rows.Count - 2).Row '<--| loop through its "inner" rows (i.e. off 1st and last rows)
Set cell = ws.Cells(iRow, 8) '<--| get current row corresponding cell in column "F"
If cell.value = "" Then Exit For '<--| exit at first blank column "F" corresponding cell
TableCalc cell '<-- call TableCalc passing the 'valid' cell as its parameter
Next iRow
End With
End Sub

VBA 'Vlookup' function operating on dynamic number of rows

I am not sure how to combine a Function with a Sub. Most likely, the Sub I have below needs corrections.
I have two tables in two separate sheets: Sheet1 and Sheet2.
Both tables have dynamic number of rows but the first rows always start in the same place and the number of columns in both tables is constant, too. Sheet1 data starts in A2 and ends in R2:R and Sheet2 data starts in A3 and ends in H3:H.
I am trying to implement VLOOkUP in column O of Sheet1, that would populate each cell in column O of Sheet1 with relevant values of column D in Sheet2. So far I managed to come up with code as below.
Public Function fsVlookup(ByVal pSearch As Range, ByVal pMatrix As Range, ByVal pMatColNum As Integer) As String
Dim s As String
On Error Resume Next
s = Application.WorksheetFunction.VLookup(pSearch, pMatrix, pMatColNum, False)
If IsError(s) Then
fsVlookup = ""
Else
fsVlookup = s
End If
End Function
Public Sub Delinquency2()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range
Dim rCell As Range
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
pSearch = ws1.Range("D2:D" & Cells(Rows.Count, "A").End(xlDown).Row)
pMatrix = ws2.Range("$A3:$H" & Cells(Rows.Count, "C").End(xlDown).Row)
pMatColNum = 4
Set rng = ws1.Range("O2:O" & Cells(Rows.Count, "A").End(xlDown).Row)
For Each rCell In rng.Cells
With rCell
rCell.FormulaR1C1 = s
End With
Next rCell
End Sub
You will need to call the function in your sub using a similar line to below. It then takes your values from your sub and inputs them into the function and returns the value.
You need to dim the ranges in order for them to be recognized correctly in your function. I have updated your code to make it work and you can fiddle around with it to make it work the way you want it to. I also updated a few other spots to figure out the correct ranges, you don't want to use xlDown where you were using it, causes an enormous loop covering cells you don't want it to.
Public Function fsVlookup(ByVal pSearch As Range, ByVal pMatrix As Range, ByVal pMatColNum As Integer) As String
Dim s As String
On Error Resume Next
s = Application.WorksheetFunction.VLookup(pSearch, pMatrix, pMatColNum, False)
If IsError(s) Then
fsVlookup = ""
Else
fsVlookup = s
End If
End Function.
Public Sub Delinquency2()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range
Dim rCell As Range, pMatrix As Range
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
pSearchCol = ws1.Range("D2:D2").Column
Set pMatrix = ws2.Range("$A3:$H" & ws2.Cells(Rows.Count, "C").End(xlUp).Row)
pMatColNum = 4
Set rng = ws1.Range("O2:O" & ws1.Cells(Rows.Count, "A").End(xlUp).Row)
For Each rCell In rng.Cells
With rCell
rCell.Value = fsVlookup(ws1.Cells(rCell.Row, pSearchCol), pMatrix, pMatColNum)
End With
Next rCell
End Sub

Excel 2010: How to Run FUNCTION procedures in a cell on another range of cell change?

I have Vba Function procedure with parameters in Module1 it works fine. I am calling it from cell which returns array(6) values updates 6 cells as a result
Cell AU3: =String_Evaluation(F3,J3,V3)
Cell AU4: =String_Evaluation(F4,J4,V4)
Cell AU5: =String_Evaluation(F5,J5,V5)
So on
Module1:
Option Explicit
Public CI_Max, CI_Min, CI_Avg, II_Max, II_Min, II_Avg, cellvalue As String
Public Tmp(6) As Variant
Function String_Evaluation(Input As String, output As String, rownumber As Range) As Variant
// Find Min Max and Average works fine
Tmp(0) = CI_Max
Tmp(1) = CI_Min
Tmp(2) = CI_Avg
Tmp(3) = II_Max
Tmp(4) = II_Min
Tmp(5) = II_Avg
String_Evaluation = Tmp
End Function
Problem:
Now I want to Automate:
Any change in the cell W1:AT344 the Function in cell AU3 to AU5 has to re execute is it Possible?
Thank You.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("W1:AT344")) Is Nothing Then
Exit Sub
Else
Dim FirstRow As Long, LastRow As Long
FirstRow = Target.Row
LastRow = Target.Row + Target.Rows.Count - 1
For FirstRow to LastRow
Range(AU"& FirstRow, "AZ" & FirstRow).Value = String_Evaluation("F" & FirstRow,"J" & FirstRow,"V" & FirstRow)
...
FirstRow = FirstRow + 1
Next
End If
End Sub
Try to understand what it's done here. It maybe won't run if you copy it one to one. But the method behind it should be clear. Everytime the worksheet changes, you have to check if one of the changed rows is in your data. Then update the changed row. Anyway i made another update to the code, try it again
#Doktor OSwaldo: Thank u I updated my code.
Module 1:
I Updated Function parameter type from “String to Range”.
Function String_Evaluation(segmstr As Range, outputstr As Range, ByVal rownumber As Range) As Variant
........
End Function
In Worksheet
Private Sub Worksheet_Change(ByVal Target As Range)
Dim FirstRow As Long, LastRow As Long
If Intersect(Target, Range("W3:AT344")) Is Nothing Then
Exit Sub
Else
LastRow = Range("AU344").Row
For FirstRow = 3 To LastRow
Range(Cells(FirstRow, 47), Cells(FirstRow, 52)) = _
String_Evaluation(Range("F" & FirstRow), Range("J" & FirstRow), Range("V" & FirstRow))
Next
End If
End Sub