I am trying to apply the =LOWERCASE() formula to four columns (J, O, T, and Y) across multiple sheets in the same workbook.
Here's the VBA code I have so far, it is applying to the right columns, but it's returning an error for each.
Sub Clean_Lowercase()
Const N As Integer = 1
Dim r As Long, i As Integer, X As Integer, t As Long
Dim rng As Range, r As Range
Dim v As Variant
v = Array("J", "O", "T", "Y")
t = 1
For i = 1 To Sheets.Count - 1
r = Sheets(i).UsedRange.Rows.Count
For X = 0 To UBound(v)
Set rng = Sheets(i).Range(v(X) & N & ":" & v(X) & r)
For Each r In rng
r.Formula = "=LOWERCASE()"
Next
Next
End Sub
I am very new to VBA coding, any suggestions is greatly appreciated! I really want to learn.
Many thanks!
There are several problems with this.
You are using the r twice, once as a Long, once az a Range.
The For Each loop's Next is missing
The formula needs a reference of what would you like to set to lowercase.
For example, if you want to have the lowercase value of the left neightbouring cells, you should write: =LOWERCASE(R[1]C[-1])
Sheets are a 1 based collection, so if you write For i = 1 To Sheets.Count - 1, the last sheet wont be processed (maybe this is intentional?) and the code will throw an error at the first sheet (no sheets(0) exist)
Something like this works:
Sub Clean_Lowercase()
Const N As Integer = 1
Dim r As Long, i As Integer, X As Integer, t As Long
Dim rng As Range, ri As Range
Dim v As Variant
v = Array("J", "O", "T", "Y")
t = 1
For i = 1 To Sheets.Count
r = Sheets(i).UsedRange.Rows.Count
For X = 0 To UBound(v)
Set rng = Sheets(i).Range(v(X) & N & ":" & v(X) & r)
For Each ri In rng
ri.Formula = "=LOWERCASE(R[1]C[-1])"
Next
Next
Next
End Sub
Related
I am looking to create a function that will take 2 ranges (of the same dimensions), and take the difference between the cell from one range and the corresponding cell in the other range, and then create a new range with all of the differences. Are there any obvious problems? If i select and crtl + sht + enter, the range fills with "#Value!"
This is what i have so far (assuming the ranges are 4 by 4s):
Function Compare_Ranges(range_1 As Range, range_2 As Range) As Range
Dim output_data As Range
Dim i As Integer
Dim j As Integer
Dim col As String
For i = 1 To 4 'looping through the columns
col = Col_Letter(i)
For j = 1 To 4 'looping through the rows
Set output_data(Col_Letter(i) & j) = range_1(Col_Letter(i) & j).Value - range_2(Col_Letter(i) & j).Value
Next j
Next i
Compare_Ranges = output_data
End Function
Where the function Col_Letter returns the correponding letter of the alphabet:
Function Col_Letter(lngCol As Integer) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function
Here is a version of your function that takes two ranges of the same size and returns an array with the same dimensions that holds the difference between each corresponding cell in the input ranges.
Function Compare_Ranges(range_1 As Range, range_2 As Range) As Variant
Dim output_data() As Variant
Dim c As Integer
Dim r As Integer
ReDim output_data(1 To range_1.Rows.Count, 1 To range_1.Columns.Count)
For c = 1 To UBound(output_data, 2) 'looping through the columns
For r = 1 To UBound(output_data, 1) 'looping through the rows
output_data(r, c) = range_1.Cells(r, c).Value - range_2.Cells(r, c).Value
Next
Next
Compare_Ranges = output_data
End Function
If you want to put this in a cell, you will need to press CTRL+ENTER after entiering the following in a cell:
=Compare_Ranges(A1:A7,B1:B7)
The function returns an array, so if you want to catch it's results by calling it in another sub procedure, you need the following"
Dim data as variant
data = Compare_Ranges(range("a1:a7"),range("b1:b7"))
I am not sure if I got this right but I hope at least will help you to get there. The function takes any two ranges and calculate the difference between them and store the result into an array.
Function Compare_Ranges(range_1 As Range, range_2 As Range, ByVal y As Long) As Variant
Dim j As Long
Dim col As String
Dim one As Object, two As Object, three As Variant
Set one = CreateObject("Scripting.Dictionary")
Set two = CreateObject("Scripting.Dictionary")
j = 0
For Each cell In range_1
one.Add Key:=j, Item:=cell.Value
j = j + 1
Next
j = 0
For Each cell In range_2
two.Add j, cell.Value
j = j + 1
Next
ReDim three(0 To j) As Variant
For i = 0 To j
three(i) = one(i) - two(i)
Next
Compare_Ranges = three(y)
End Function
Then you can use the code in the sub to populate them in any range you like.
Sub result()
Dim one As Range, two As Range, three As Range
Dim j As Long
Set one = Worksheets("Sheet1").Range("A1:A4")
Set two = Worksheets("Sheet1").Range("B1:B4")
Set result = Worksheets("Sheet1").Range("D8:D11")
j = 0
For i = three.Row To ((result.Row + result.Rows.Count) - 1)
Worksheets("Sheet1").Cells(i, result.Column) = Compare_Ranges(one, two, j)
j = j + 1
Next
End Sub
I am having trouble trying to include something into a macro I am building. I need it to search through column C
for cells that say "start trans" and in one column over (d)- the first value will be equal to zero, next instance should be 100, next instance 0 next instance 100 so on until the end of the data.
Instances are not always every 4th line and I have other zeros that I want it to overlook.
Thank you for any help!
How about this one:
Sub GoGoGo()
Dim l As Long: Dim i As Long
Dim b As Boolean
With ActiveSheet
l = .Cells(.Rows.Count, "C").End(xlUp).Row
For i = 5 To l
If .Cells(i, "C").Value2 = "start trans" Then .Cells(i, "D").Value2 = b * -100: b = Not b
Next i
End With
End Sub
Try this.
Sub test()
Dim rngDB As Range, rng As Range
Dim n As Long, Result As Integer
Set rngDB = Range("c5", Range("c" & Rows.Count).End(xlUp))
For Each rng In rngDB
If rng = "start trans" Then
n = n + 1
If n Mod 2 Then
Result = 0
Else
Result = 100
End If
rng.Offset(0, 1) = Result
End If
Next rng
End Sub
In column B on three (Bakery, Floral, Grocery) of the five sheets in my workbook, I want to find rows that have the word Flyer in column B. There will be multiple rows in each worksheet that have the word Flyer in column B. When it finds the word Flyer, it will paste the entire row into Sheet1.
I go this to work on one tab, but want the same code to search all three tabs (but NOT all five ... this is the issue) and paste all of the rows with the word Flyer in column B into Sheet1.
My code (works, but only on the Bakery tab):
Sub CopyRowsFlyer()
'This looks in the Bakery tab and moves everything that has "Flyer" in column B to Sheet 1
Dim bottomB As Integer
Dim x As Integer
bottomB = Sheets("Bakery").Range("B" & Rows.Count).End(xlUp).Row: x = 1
Dim c As Range
For Each c In Sheets("Bakery").Range("B3:B" & bottomB)
If c.Value = "Flyer" Then
c.EntireRow.Copy Worksheets("sheet1").Range("A" & x)
x = x + 1
End If
Next c
End Sub
Similar to other solutions posted. Pretty simple. Replaces bounding for range checking. Fewest variables. No mid-execution dimensioning.
Sub CopyRowsFlyer()
Dim strSh As Variant, c As Range, x As Integer
x = 1
For Each strSh In Array("Bakery", "Floral", "Grocery")
For Each c In Worksheets(strSh).Range("B:B")
If c = "" and c.Row > 2 Then
Exit For
ElseIf c = "Flyer" and c.Row > 2 Then
c.EntireRow.Copy Worksheets("Sheet1").Range("A" & x)
x = x + 1
End If
Next
Next
End Sub
You just want to loop through the three sheets you want. Try this:
Sub CopyRowsFlyer()
'This looks in the Bakery tab and moves everything that has "Flyer" in column B to Sheet 1
Dim bottomB As Integer
Dim x As Integer
Dim SheetsArray() As Variant
Dim ws As WorkSheet
Dim i As Integer
SheetsArray = Array("Bakery", "Sheet2Name", "Sheet3Name")
For i = LBound(SheetsArray) To UBound(SheetsArray)
Set ws = Sheets(SheetsArray(i))
bottomB = ws.Range("B" & Rows.Count).End(xlUp).Row: x = 1
Dim c As Range
For Each c In ws.Range("B3:B" & bottomB)
If c.Value = "Flyer" Then
c.EntireRow.Copy Worksheets("sheet1").Range("A" & x)
x = x + 1
End If
Next c
Next i
End Sub
You can substitute an element of a string array for the ID in Sheets.
Here is your code modified to reflect.
Sub CopyRowsFlyer()
Dim bottomB As Integer
Dim x As Integer
Dim sheetName(1 to 3) As String, i as Integer
sheetName(1) = "Bakery"
sheetName(2) = "Floral"
sheetName(3) = "Grocery"
x=1
For i = 1 to 3
bottomB = Sheets(sheetName(i)).Range("B" & Rows.Count).End(xlUp).Row
Dim c As Range
For Each c In Sheets(sheetName(i)).Range("B3:B" & bottomB)
If c.Value = "Flyer" Then
c.EntireRow.Copy Worksheets("sheet1").Range("A" & x)
x = x + 1
End If
Next c
Next i
End Sub
Store the desired worksheet names in an array and loop through them.
Sub CopyRowsFlyer()
Dim bottomB As Long, b As Long, x As Long
Dim w As Long, vWSs As Variant
vWSs = Array("Bakery", "Floral", "Grocery")
x = 1
For w = LBound(vWSs) To UBound(vWSs)
With Worksheets(vWSs(w))
bottomB = .Range("B" & Rows.Count).End(xlUp).Row
For b = 3 To bottomB
If LCase(.Cells(b, "B").Value) = "flyer" Then
.Rows(b).EntireRow.Copy Worksheets("sheet1").Range("A" & x)
x = x + 1
End If
Next b
End With
Next w
End Sub
While this method of looping through the cells in each worksheet's column B is considered inefficient compared to other methods like the .Range.Find method, it will not make a lot of difference on smaller sets of data. If you have a large number of rows on each worksheet to examine, you may wish to explore other more direct avenues of retrieving the information.
There are 4 columns on my excel.
For every element in column A, I would like to loop through every element column C. If the element in column C equal to column A, then it return the value of column D in column B.
For example, B4 should return "dog". B5 should return "egg". B6 should return "cat".
I ran my VBA code. All the value in column B returns "egg". Could someone have a look with my below VBA code please?
Sub testing_click()
Dim x As Variant
Dim arr1 As Variant
Dim i , r As Long
arr1 = Worksheets("testing").Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
For Each x In arr1
For r = 1 To 5
If x = Trim(Worksheets("testing").Cells(r, "c").Value) Then
For i = 1 To Worksheets("testing").Range("a1048576").End(xlUp).Row
Worksheets("testing").Cells(i, "b").Value = Worksheets("testing").Cells(r, "d").Value
Next i
End If
Next r
Next x
End Sub
Just had one too many loops in there. What it was actually doing was finding the first value correctly, and putting it in all 12 rows of column "B". Then finding the second value, and re-assigning all 12 rows of column "B".
Get rid of the innermost loop, add counter in it's place with the same name, and you're good to go. Now, instead of looking through all cells in column "A", it only looks through the populated ones, and will terminate the inner loop as soon as it has a match.
Also corrected a mistake in the declarations. Dim i, r As Long actually only casts r as long, and i as Variant. Dim i as Long, r as Long will capture them both as Long types.
Hope it helps!
Sub testing_click()
Dim x As Variant
Dim arr1 As Variant
Dim i as Long, r As Long
arr1 = Worksheets("testing").Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
'initialize row counter out here
i = 1
For Each x In arr1
For r = 1 To 5
If x = Trim(Worksheets("testing").Cells(r, "c").Value) Then
Worksheets("testing").Cells(i, "b").Value = Worksheets("testing").Cells(r, "d").Value
'Increment row counter and exit inner loop
i = i + 1
Exit For
End If
Next r
Next x
End Sub
arr1 must be Dim'ed as array ... e.g. Dim arr1() As Variant
I also recommend to substitute the End(xlUpDownLeftRightHomeEnd)'s by more VBA like loop constructs, e.g.
Sub ClassicalLoops()
Dim OuterLoop As Integer, InnerLoop As Integer
Dim DataRange As Range, LookupRange As Range
Set DataRange = [A1]
Set LookupRange = [C1]
OuterLoop = 1
Do While DataRange(OuterLoop, 1) <> ""
InnerLoop = 1
Do While LookupRange(InnerLoop, 1) <> ""
If DataRange(OuterLoop, 1) = LookupRange(InnerLoop, 1) Then
DataRange(OuterLoop, 2) = LookupRange(InnerLoop, 2)
Exit Do
Else
InnerLoop = InnerLoop + 1
End If
Loop
OuterLoop = OuterLoop + 1
Loop
End Sub
I would like to, if possible, create a VBA macro to search the entire column A for any words that contain the letters RU (case sensitive, if possible). I would then like for it to be able to copy those words and paste them on a new sheet starting on A1, then A2, etc. I know how to set the range, but I don't even know how to begin to write the rest. Any help will be greatly appreciated.
Best Regards.
Consider:
Sub RUthere()
Dim RU As String, N As Long, K As Long, _
s1 As Worksheet, s2 As Worksheet, r As Range, _
v As Variant
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
RU = "RU"
K = 1
N = s1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To N
Set r = s1.Cells(i, "A")
v = r.Value
If InStr(1, v, RU) > 0 Then
r.Copy s2.Cells(K, "A")
K = K + 1
End If
Next i
End Sub