I've been trying to look this up everywhere and I can't seem to find the answer or get it to work.
I have the code
'Define Variables for cell ranges'
Dim BidItem As Range
Dim BidItemDes As Range
Dim BidItemUnit As Range
Dim BidItemQTY As Range
Dim BidItemUP As Range
'Store the sheet range into the variables'
Set BidItem = Sheets("BidItems").Range("A1:A" & Range("A1").End(xlDown).Row)
Set BidItemDes = Sheets("BidItems").Range("B1:B" & Range("B1").End(xlDown).Row)
Set BidItemUnit = Sheets("BidItems").Range("C1:C" & Range("C1").End(xlDown).Row)
Set BidItemQTY = Sheets("BidItems").Range("D1:D" & Range("D1").End(xlDown).Row)
Set BidItemUP = Sheets("BidItems").Range("E1:E" & Range("E1").End(xlDown).Row)
Set BidItemValue = Sheets("BidItems").Range("F1:F" & Range("F1").End(xlDown).Row)
Set BidItemValue = Sheets("BidItems").Range("F1:F" & Range("F1").End(xlDown).Row)
What I need to do is have all the data in range BidItemQTY and Multiply it by the range BidItemUP
and then output that answer to the range BidItemValue.
I have the last line of code setup to start the function but
I can't seem to grasp on how to do math functions in VBA with Variables.
Consider this tiny example:
Sub dural()
Dim second As Range
Dim first As Range, prodt As Long
Set first = Range("A1:A3")
Set second = Range("B1:B3")
prodt = Application.WorksheetFunction.SumProduct(first, second)
MsgBox prodt
End Sub
EDIT#1:
To get the individual products stored in cells, use:
Sub dural()
Dim second As Range
Dim first As Range, prodt As Long
Dim third As Range
Set first = Range("A1:A3")
Set second = Range("B1:B3")
Set third = Range("C1:C3")
For i = 1 To 3
third(i, 1) = first(i, 1) * second(i, 1)
Next i
End Sub
Notes:
since the ranges are not single cells, we treat them as two-dimensional
it may be possible to avoid the loop using Transpose()
in this case the one-dimensional will also work:
For i = 1 To 3
third(i) = first(i) * second(i)
Next i
Related
I'm new to VBA, so thank you in advance for your patience. I wrote a sub that takes the part number (PN) in Range C2 and performs three different split and left functions to fill in the columns to the left and right of the PN with extracted portions of the PN string. Here is a screenshot of the columns and what it fills in.
Here is my code so far:
Sub PN_Autotfill1()
Dim PN As Range
Dim SCPort_Type As Range
Dim SCPort_Size As Range
Dim Start_FittingSize As Range
Dim PN_String As String
Dim PN_1 As Variant
Dim PN_2 As Variant
Dim PN_3 As Variant
Set PN = Range("C2")
Set SCPort_Type = PN.Offset(, -2)
Set SCPort_Size = PN.Offset(, -1)
Set Start_FittingSize = PN.Offset(, 1)
PN_String = PN.Value
If InStr(PN_String, "Flange") > 0 Then
'Splits PN into SC Port Type
PN_1 = Split(PN_String, "#")(1)
PN_2 = Left(PN_1, 2)
SCPort_Type.Value = "#" & PN_2 & "Flange"
'Splits PN into SC Port Size, Start, and End Fitting
PN_3 = Split(PN_1, "-")(1)
SCPort_Size = PN_3
Start_FittingSize = PN_3
End If
End Sub
Now I want to make a loop that applies these functions to each cell containing a PN in column C. I've found some good examples on Stackoverflow and a VBA tutorial website that create loops for a single split function, but not for multiple split functions. It looks like two For loops will come into play: LastRow = Cells(Rows.Count, "C").End(xlUp).Row with For a = 2 To LastRow, and For i = 1 To UBound(Unsure what goes here). Does anyone have tips or example code for how to go about this? Thank you in advance for any help!
Here is the code with Jamheadart's answer integrated in:
Sub PN_Autotfill_Functions(PN As Range)
Dim SCPort_Type_Size As Range
Dim Start_FittingSize As Range
Dim PN_String As String
Dim LastRow As Single
Dim PN_1 As Variant
Dim PN_2 As Variant
Dim PN_3 As Variant
Set SCPort_Type_Size = PN.Offset(, -1)
Set Start_FittingSize = PN.Offset(, 1)
PN_String = PN.Value
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
If InStr(PN_String, "Flange") > 0 Then
'Splits PN into SC Port Type and Size, then combines results
PN_1 = Split(PN_String, "#")(1)
PN_2 = Left(PN_1, 2)
PN_3 = Split(PN_1, "-")(1)
SCPort_Type_Size.Value = "#" & PN_2 & " Flange" & ", -" & PN_3
'Fills in Start and End Fitting Size based on previous Split of PN
Start_FittingSize = PN_3
End If
End Sub
Sub PN_Autofill_Loop()
Dim a As Long
Dim PN As Range
Set PN = ActiveCell
For a = 2 To 11
PN_Autotfill_Functions Range("C" & a)
Next a
End Sub
You don't need multiple loops, you just need to run your sub in a loop - and each time you run it, it will take in a range (e.g. C2)
So change your routine first line to this:
Sub PN_Autotfill1(PN as Range)
And get rid of these two lines:
Dim PN As Range
Set PN = Range("C2")
This means PN is now a parameter for the routine, instead of it being defined in the routine itself.
You could then call it for a few ranges, like this:
Sub Testing()
PN_Autotfill1 Range("C2")
PN_Autotfill1 Range("C4")
PN_Autotfill1 Range("C7")
End Sub
And finally if you want to loop through say ten rows you could call it in a loop with a different sub routine:
Sub LoopingExample
Dim i As Long
For i = 2 to 11
PN_Autotfill1 Range("C" & i)
Next i
End Sub
It's worth noting that this ease is only possible because your original code is constructed quite well (e.g. it's using Offset instead of hard-coded ranges etc.)
I'm trying sort a predetermined range of cells from a UserForm (let's say A1:A5) using an array size as an integer, and the array itself. I've checked out 20+ links without finding a solution.
The code below successfully gets the values of the array (for my testing there are five doubles), pastes them into the worksheet sheetOperations (I always use code-targeted sheets to minimize issues). So the sheet targeting works, and the looping through the array and getting the values works.
Sorting the range (A1:A5) hasn't been successful. I've tried a variety of code. I'm trying to get A1 to A5 (on that specific worksheet) to list the previous values in the range in descending order - when I run this code (I tried ascending, descending) it has given me various errors such 1004, etc.
If A1:A5 is {1,3,2, 4, 6}, I want it to make A1:A5 {6,4,2,3,1}.
Sub timeStampStorePart2(ByRef doubleArray() As Double, ByVal size As Integer)
Dim ws As Worksheet
Dim wsFound2 As Worksheet
For Each ws In ThisWorkbook.Worksheets
If StrComp(ws.CodeName, "sheetOperations", vbTextCompare) = 0 Then
Set wsFound2 = ws
'MsgBox ("Found")
End If
Next ws
Dim loopInt As Integer
Dim arrayInt As Integer
Dim rangeAddress As String
arrayInt = 0
loopInt = 1
For loopInt = 1 To size
rangeAddress = "A" & loopInt
wsFound2.Range(rangeAddress).Value = doubleArray(arrayInt)
arrayInt = arrayInt + 1
Next loopInt
'rangeAddress = "A1:" & rangeAddress
'MsgBox (rangeAddress)
'Dim dataRange As Range
'Set dataRange = wsFound2.Range(rangeAddress)
wsFound2.Range("A1:A5").Sort key1:=Range("A2"), order1:=xlAscending, Header:=xlNo
End Sub
In answer to your question, here is a pretty simple code that sorts the range you describe using an array...
slightly updated to meet the integer requirement.
Sub sortStuff()
Const addr As String = "A1:A6"
Dim WS As Worksheet: Set WS = ActiveSheet 'or whatever the sheet ID name is
Dim sRNG As Range: Set sRNG = WS.Range(addr)
'changed this from first answer to integer requirement and optimize code
ReDim aRay(1 To sRNG.Rows.Count, 1 To sRNG.Columns.Count) As Integer
Dim x As Long, y As Long
For x = LBound(aRay, 1) To UBound(aRay, 1)
For y = LBound(aRay, 2) To UBound(aRay, 2)
aRay(x, y) = Application.WorksheetFunction.Large(sRNG.Columns(y), x)
Next y
Next x
'Puts into excel
sRNG = aRay
End Sub
I'm trying to look for the last row of data between column A and I and then duplicate the value to the row below which is empty.
Every time I run it, Excel crashes
Sub insert_row()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
LastRow = LastRow
Dim lastrow_start As String
Dim lastrow_end As String
lastrow_start = "A" & LastRow
lastrow_end = "I" & LastRow
Dim lastrowregion As String
lastrowregion = lastrow_start & ":" & lastrow_end
Dim lastrowrange As Range
Set lastrowrange = Range(lastrowregion)
Dim rng As Range
Set rng = Range(lastrow_start)
Do While (rng.Value <> "")
rng.Offset(1).insert
lastrowrange.Copy rng.Offset(1)
Set lastrowrange = rng.Offset(2)
Loop
End Sub
Is it just copying too much and causing a crash? It's only nine columns and they're all text apart from one cell which is a shape (button).
You are trying to set a String to a range object. To get the range use:
Set rng = Range(lastrowregion)
The Range you are getting is A2:I2. So your Do While will error because rng.Value is actually returning an Array. You could either loop through either the Range or the Array at that point if you intended on it being multiple cells.
If the goal is simply to copy the last row of data down one row then this method can be much simpler. You can simply set the Offset to equal the value of the last row. Since they are the same size it will just work.
To show this I used CurrentRegion but you could also do it with your A2:I2 Range.
Public Sub copyLastRowDown()
Dim region As Range
Set region = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
With region.Rows(region.Rows.Count)
.Offset(1).Value = .Value
End With
End Sub
Additional Notes
Use Option Explicit to ensure all variables are explicitly declared.
Declare and assign variables next to where they are going to be used, but place them in a reasonable place.
Do not use underscore case as this has special meaning with events and interfaces.
I have a big problem with my script VBA, I want to create a script VBA which will enable to make the sum of some cells on a sheet and to display them on another sheet according to some criteria.
But the function SumIfs is returning zero value.
This is my script:
If Worksheets("Test").Range("B2").Text = Worksheets("Nomen").Range("K3").Text Then
Worksheets("Test").Range("C23").Value = Application.WorksheetFunction.SumIfs(Worksheets("DETAILS").Range("H2:H174"), Worksheets("DETAILS").Range("B2:B174"), Worksheets("Nomen").Range("K3"), Worksheets("DETAILS").Range("J2:J174"), Worksheets("Test").Range("C2")
End If
Picture1
Picture2
You are trying to sum text hence zero.
I put into variables to make easier to debug.
Sub test()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim sumRange As Range
Set sumRange = wb.Worksheets("DETAILS").Range("H2:H174")
Dim critRange1 As Range
Set critRange1 = Worksheets("DETAILS").Range("B2:B174")
Dim crit1 As Variant
crit1 = Worksheets("Nomen").Range("K3")
Dim critRange2 As Range
Set critRange2 = Worksheets("DETAILS").Range("J2:J174")
Dim crit2 As Variant
crit2 = Worksheets("Test").Range("C2")
MsgBox Application.WorksheetFunction.SumIfs(sumRange, critRange1, crit1, critRange2, crit2)
End Sub
If I fill each range with 1 and also try to match on one I get 174 back. If I populate sumRange with "A", in the same way you have used text, I get 0. i.e. if I replace all the 1's with A.
I want to give a range instead of offset in the following code. following code copies the color from range(C5:F11) to the offset i set but i want to specify a range like range(M5:P11). I tried it simply replacing offset by range but it does not work properly. Please help
Sub MatchColors2()
For Each myCellColor In Range("C5:F11")
myCellColor.Offset(0, 8).Interior.ColorIndex = myCellColor.Interior.ColorIndex
Next
End Sub
Thanks
Along with your requirement, this also works for ranges with more than one Area, i.e., non-contiguous ranges:
Sub MatchColors2()
Dim rngTo As Excel.Range
Dim rngFrom As Excel.Range
Dim i As Long
Dim j As Long
Set rngTo = ActiveSheet.Range("C5:D11,F5:G11")
Set rngFrom = ActiveSheet.Range("I5:J11,L5:M11")
For i = 1 To rngFrom.Areas.Count
For j = 1 To rngFrom.Areas(i).Cells.Count
rngTo.Areas(i).Cells(j).Interior.ColorIndex = rngFrom.Areas(i).Cells(j).Interior.ColorIndex
Next j
Next i
End Sub