I am a beginner in VBA trying to loop through cells from a specified range that is entered into a refEdit on a user form, this range always has 2 columns but could have any number of rows. The first column is a category and the second column is numerical values. I want to find the sum of the corresponding values of a specific category. For example, very time I come across the word "coffee" in a cell I want to take the value in the cell to its right and start summing them to print the value of all coffee in cell C1. How can I get this to work?
Here is what I have been working with:
dim cell, myRange as Range
dim c as string
dim r as long
Set myRange = Range(RefEdit1.Text)
c = "coffee"
r = 0
For Each cell In myRange
If VBA.LCase(cell) = VBA.LCase(c) Then
r = r + ActiveCell.Offset(0, 1).Value
End If
next cell
range("C1") = r
SumIf vs Loop
Loops are usually best avoided due to slowing down the code.
SumIf 'is' not case-sensitive so you are also avoiding the 'LCase-business'.
When declaring variables in one line, you have to 'use an As' for each variable or it will be declared as Variant (cell).
Option Explicit
Sub testSumIf()
Dim myRange As Range
Dim c As String
Set myRange = Range(RefEdit1.Text)
c = "coffee"
Range("C1").Value _
= Application.SumIf(myRange.Columns(1), c, myRange.Columns(2))
End Sub
Sub testLoop()
Dim cell As Range, myRange As Range
Dim c As String
Dim r As Long
Set myRange = Range(RefEdit1.Text)
c = VBA.LCase("coffee")
For Each cell In myRange.Cells
If VBA.LCase(cell.Value) = c Then
r = r + cell.Offset(0, 1).Value
End If
Next cell
Range("C1").Value = r
End Sub
Related
I have to run the code twice to get the right answer.
The bug is somewhere in the for loop commented as "finds static.press cell location"
Sub find()
Dim A As Double
Dim B As Variant
Dim c As Integer
Dim x As Range
Dim cell As Range
Dim rng As Variant
Dim r As Variant
Dim Mx As Long
Dim i As Long
Dim target As Double
Set wks = Worksheets("comefri")
Set wkks = Worksheets("TEST")
Dim p As Long
'RPM INPUT
A = wkks.Range("C18").value
'Static Pressure Input
B = wkks.Range("C19").value
'copy comefri values to test sheet
Sheets("comefri").Range("A9:gs24").Copy Destination:=Sheets("test").Range("a1:gs16")
With test
' Row Numb used in rangelookup
c = Range("C20").value
d = Range(Cells(c, 102), Cells(c, 201))
For Each cell In [a2:gs16]
cell = WorksheetFunction.Round(cell, 1)
Next cell
'Finds RPM cell location
Set cell = Range("a:a").find(What:=A, LookAt:=xlWhole, MatchCase:=fasle, SearchFormat:=False)
Range("c20") = cell.row
'finds static.press cell location
target = B
Set rng = Range(Cells(c, 102), Cells(c, 201))
'rng.Offset(, 1).ClearContents
Mx = Application.Max(rng)
For Each B In rng
If Abs(target - B) < Mx Then
Mx = Abs(target - B)
i = B.row
p = B.Column
End If
Next B
Debug.Print i
Debug.Print p
Range("d19").value = p
Range("e19").value = i
End With
End Sub
The first time the code runs, I think it uses the values from previous inputs and the second time I run it, it uses the new inputs.
I think I need a line of code to clear old inputs.
The problem is that you pull the value of c from a cell value (Sheets("TEST").Range("C20")). You update the cell value (on this line: Range("c20") = cell.row), but don't update the value of c. As such, when you set your rng variable, it's still using the old c value.
To resolve this, instead of this:
Set rng = Range(Cells(c, 102), Cells(c, 201))
Use this:
Set rng = wkks.Range(wkks.Cells(cell.Row, 102), wkks.Cells(cell.Row,201))
Lastly some generic advice:
As Cyril already stated, use descriptive variable names instead of single letters
Once a variable is set in the code, use the variable instead of referencing worksheet cells
Use proper indenting for your code to make it easier to read and follow
Always fully qualify your range objects to avoid confusion
Use your worksheet objects that you set instead of referencing worksheets by their codename
my code is to run through a table and store the cell color of column D while also storing the value of in column C as another variable. These variables are used to find a shape on another the "main" tab and update that color to the color that was stored in CellColor. When I added the loop part of the code I get an out of bounds error (-2147024809 (80070057)).
Sub Update()
Dim CellColor As Long
Dim ShapeColor As Variant
Dim rng As Range, Cell As Range
Dim i As Integer
Worksheets("Sheet1").Select
Set rng = Range("C2:C100")
For i = 2 To rng.Rows.Count
CellColor = rng.Cells(RowIndex:=i, ColumnIndex:="D").DisplayFormat.Interior.Color
ShapeColor = rng.Cells(RowIndex:=i, ColumnIndex:="C").Value
Worksheets("main").Shapes(ShapeColor).Fill.ForeColor.RGB = CellColor
i = i + 1
Next
Worksheets("main").Select
End Sub
Perhaps use a For Each loop here and Offset:
Set rng = Worksheets("Sheet1").Range("C2:C100")
Dim cell As Range
For Each cell In rng
ShapeColor = cell.Value
CellColor = cell.Offset(,1).DisplayFormat.Interior.Color
Worksheets("main").Shapes(ShapeColor).Fill.ForeColor.RGB = CellColor
Next
A brief explanation of your problem:
rng.Cells(RowIndex:=i, ColumnIndex:="C")
rng.Cells(RowIndex:=i, ColumnIndex:="D")
are not the cells you think they are, because they are offsetting but starting from column C. They are actually referring to columns E and F.
As an example: ? Range("C2").Cells(1, "C").Address returns $E$2, not $C$2.
Other points:
Remove the i = i + 1. Next is what increments i.
Avoid using Select: Set rng = Worksheets("Sheet1").Range("C2:C100").
I have been looking through multiple posts on looping through multiple named ranges and returning values to another cell. Unfortunately, I am getting stuck on how to loop through two named ranges to return the value from one named range if a cell in another named range is "X".
Below are images of the named ranges with values and the intended result in cell I46. Please note there is no formula in I46.
Named Ranges: Range1 Range2
Desired result from macro aftter loop is complete:
Code:
For Each Cell In wspGen.Range("Ineligible")
If Cell.Value = vbNullString Then
LP.zPledge.Value = "Y"
wspGen.Range("A46") = "-"
wspGen.Range("AG55").Value = "X"
Else
If Cell.Value = "X" Then
wspGen.Range("AG55").Value = vbNullString
wspGen.Range("A45").Value = "N"
LP.zPledge.Value = "N"
'Copies the corresponding value from range ("IneligibilityCode")
'if there is an "X" in any of the cells in range ("Ineligible")
'to I46. This could be multiple combinations of values in range ("IneligibilityCode")
End If
End If
Next Cell
Thank you all for your assistance.
This is a simple example using a counter variable assuming both ranges are single column and aligned. It counts how many cells down the first named range
(set in variable a) it is before x is found and retrieves the value at the same position in the named range b. Note I am using implicit active sheet references and you should specify the sheet name before the named ranges.
Option Explicit
Public Sub test()
Dim a As Range, b As Range, rng As Range, counter As Long
Set a = Range("range1"): Set b = Range("range2")
For Each rng In a
counter = counter + 1
If rng = "x" Then
Range("I46") = b.Cells(counter)
Exit For
End If
Next
End Sub
Space separated list of all matches:
Option Explicit
Public Sub test()
Dim a As Range, b As Range, rng As Range, counter As Long, outputString As String
Set a = Range("range1"): Set b = Range("range2")
For Each rng In a
counter = counter + 1
If rng = "x" Then
outputString = outputString & Chr$(32) & b.Cells(counter)
End If
Next
wspGen.Range("I46") = Trim$(outputString) ' wspGen.Range("I46") is defined in your code. This is illustrative.
End Sub
I have a worksheet that contains a varying amount of Rows of data in Column A , within this worksheet I need to search for a specific string then copy the data contained in the Cell adjacent to it and paste into Column C, i.e if data was found in A2 then i need to copy the data from B2 and paste into C1. I can easily find and copy when the string appears once but the string will appear more than once 100% of time. here is when i run into issues.
The temporary code I have written for ease of understanding, searches the spreadsheet for the last Mention of A, get the row number, copy the B cell for that row number then pastes the value into C1.
I guess you need to use range variables for this but not 100% sure how to do it.
i have found no way to copy all mentions of A into a column, or ideally sum up the contents of the B cells. (I can do this, just long winded)
Ive placed my code below.
Sub ValueFinder()
Dim LastALocation As String
Dim ValueContent As String
LastALocation = Range("A:A").Find(What:="A", after:=Range("A1"), searchdirection:=xlPrevious).Row
ValueContent = Cells(LastALocation, 2)
Cells(1, 3) = ValueContent
End Sub
The spreadsheet that its using for more information, contains A,B,C on a loop in Column A and the odd numbers in Column B.
Thanks for any help your able to provide.
Mark
This will look for a string in Column A, and add to Column C the same row's B Column Value.
Sub find_move()
Dim foundCel As Range
Dim findStr As String, firstAddress As String
Dim i As Long
i = 1
findStr = "A"
Set foundCel = Range("A:A").Find(what:=findStr)
If Not foundCel Is Nothing Then
firstAddress = foundCel.Address
Do
Range("C" & i).Value = foundCel.Offset(0, 1).Value
Set foundCel = Range("A:A").FindNext(foundCel)
i = i + 1
Loop While Not foundCel Is Nothing And foundCel.Address <> firstAddress
End If
End Sub
Note: You should add the worksheet in front of all the range values, i.e. Sheets("Sheet1").Range("A:A").Find(...
Consider:
Sub LookingForA()
Dim s As String, rng As Range, WhichRows() As Long
Dim rFound As Range
ReDim WhichRows(1)
s = "A"
Set rng = Range("A:A")
Set rFound = rng.Find(What:=s, After:=rng(1))
WhichRows(1) = rFound.Row
Cells(1, 3) = Cells(rFound.Row, 2)
Do
Set rFound = rng.FindNext(After:=rFound)
If rFound.Row = WhichRows(1) Then Exit Do
ReDim Preserve WhichRows(UBound(WhichRows) + 1)
WhichRows(UBound(WhichRows)) = rFound.Row
Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, 3) = Cells(rFound.Row, 2)
Loop
End Sub
This code builds column C. It also builds an internal array of the row numbers in the event they are needed later.
EDIT#1:
To read about dynamic arrays:
Dynamic Arrays
or Google:
Excel VBA dynamic array
This code is giving me trouble. I wanted to scan for a keyword in column B, and displays the value of the cell next to it (so it would be column A same row) in a separate worksheet. I have written the code, and highlighted the troubled part. It only displays the final value and not the rest of the values. I would appreciate any help.
Dim MyRange As Range
Dim rcell As Range
Dim Sum_Payment As Double
Dim Dates_Array() As Double
Dim Cash_Array() As Double
Dim i As Integer
Set MyRange = Worksheets("Database").Range("B2:B50")
For Each rcell In MyRange.Cells
If rcell.Value = "Payment" Then
***For i = 1 To 30***
Sum_Payment = Sum_Payment + rcell.Offset(0, 2).Value
***Dates_Array(i) = rcell.Offset(i, -1).Value
ThisWorkbook.Sheets("Sheet2").Range("A10:A20") = Dates_Array(i)***
Next i
End If
Next rcell
ThisWorkbook.Sheets("Sheet2").Range("B2") = Sum_Payment
You're overwriting the same range every time you go through the loop. If I understand your description correctly, this line...
ThisWorkbook.Sheets("Sheet2").Range("A10:A20") = Dates_Array(i)
...should be:
ThisWorkbook.Sheets("Sheet2").Cells(rcell.Row, 1) = Dates_Array(i)