I have two tables: "VALUES" and "INSERT". In Table "INSERT" the cell "A1" contains a value that needs to be coped down as many times as there are rows > "" in "VALUES"
I have tried the following code but it does not work as I intended but copies the value of "A1" 4 times every other row in "VALUES".
What am I doing wrong? Thank you for your help!
Sub InsertValuePart()
Dim maxRow As Integer
Dim calcVal As String
Dim x As String
Dim i As Long
Sheets("VALUES").Select
maxRow = Cells(Rows.Count, 1).End(xlUp).row
Sheets("INSERT").Select
Cells(1, 1).Activate
x = Cells(1, 1).Value
Cells(2, 1).Select
For i = 1 To maxRow
Cells(i, 1).Value = x
i = i + 1
Next
Application.CutCopyMode = False
Range("A1").Select
End Sub
No need to define i as it is treated in your for command. Also a for command will automatically iterate over each value so using i = i + 1 will give you values of i = 1, 3, 5. If you do not include that then i = 1,2,3,....,maxRow. Also calcVal was not used anywhere so I got rid of it.
Sub InsertValuePart()
Dim maxRow As Integer
Dim x As String
maxRow = Sheets("VALUES").Cells(Rows.Count, 1).End(xlUp).Row
x = Sheets("INSERT").Cells(1, 1).Value
For i = 1 to maxRow
Sheets("INSERT").Cells(i,1).Value = x
Next
Sheets("INSERT").Range("A1").Select
End Sub
Another way to do it is listed below on one line:
Sub InsertValuePart()
Sheets("INSERT").Range("A1", "A" & CStr(Sheets("VALUES").Cells(Rows.Count, 1).End(xlUp).Row)).Value = Sheets("INSERT").Range("A1").Value
End Sub
Related
I have in column A multiple strings of numbers that look like:
2222222266622222266666222222222222266622666666222
2222266666622222222666662222666222222666222222222
2222266622226666662266622266622222222222222222666
2222222222222666222226662266622226666622222222666
2666662266622222222222222222222666222222666222666
2222266622222666666666662266622222222222222222222
6662266622226662222266622222666222222266622222222
2666622666666222666222222666222222222222222222222
2222266626662666222222266622222222222666222266622
and so on.
I'm trying to find the values that are 90% the same or another percentage that I would choose before I run the program.
The expected result should be in column B how many other cells would share the same structure as much as an percentage with column A, and if it is possible in next column or columns, the cells that gave that similitude
My first try:
Sub Similar()
Dim stNow As Date
Dim DATAsheet As Worksheet
Dim firstrow As Integer
Dim finalrow As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim String_i, Len_i, String_j, Len_j
stNow = Now
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set DATAsheet = Sheet1
DATAsheet.Select
firstrow = Cells(1, 2).End(xlDown).Row
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = firstrow To finalrow
For j = firstrow To finalrow
If i > 3 And j > 3 And i <> j Then
String_i = Cells(i, 1).Value
Len_i = Len(String_i)
String_j = Cells(j, 1).Value
Len_j = Len(String_j)
For k = 1 To Len_i
For l = 1 To Len_j
If Mid(String_i, k, 1) = Mid(String_j, l, 1) Then
Cells(j, 2).Value = Cells(j, 2).Value + 1
End If
Next l
Next k
End If
DoEvents
Next j
Application.StatusBar = "Loop 1/1 --- Done: " & Round((i / finalrow * 100), 0) & " %"
Next i
Application.StatusBar = ""
MsgBox "Done"
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
But it gaves me in column B the results:
259461.00
262794.00
262794.00
262794.00
259461.00
266123.00
259461.00
259461.00
Any help is appreciated.
Thanks!!!
VladMale first we will need lengt of this string - function LEN, and then we will need comparing substrings - function MID. Second function should be made in some loop from first to last character in a string, and every time it will match, some other cell should count how many times it mached and how many not. The posivite result we can divide by the string length * 100 and compare if it is more or less than 90%
I'm writing a code to loop through an excel sheet and changing the text (in column B) to uppercase/lowercase, depending on the value of cell in column N on the same row.
Macros purpose:
loop through cells in column B starting at row 2 and changing the string from upper to lowercase or vice versa, depending on the value of the cell in column N (lowercase if value = 5, other cases text should be uppercase)
Code I've got so far:
Sub CAPS()
'
' CAPS Macro
'
Dim Rang As Integer
Dim j As Integer
j = 2
For Each N In Source.Range("N2:N10000") ' Do 10000 rows
Rang = Cells(j, 14)
If Rang = 5 Then
Cells(j, 2).Range("A1").Select
ActiveCell.Value = LCase$(ActiveCell.Text)
Else
ActiveCell.Value = UCase$(ActiveCell.Text)
j = j + 1
End If
Next N
End Sub
I'm a little bit stuck in the looping part, not really a clue how to fix the error(s) in the current code.
Thanks in advance :)
Sub CAPS()
'
' CAPS Macro
'
Dim N as long 'use long here as integer is limite to a 32b character
For N Is 2 to 10000 ' Do 10000 rows
If Cells(N, 14) = 5 Then
Cells(N, 2) = LCase(Cells(N,2)
Else
Cells(N, 2) = UCase(Cells(N,2)
EndIf
Next N
End Sub
This should do the trick, untested though.
You currently have a fixed number of rows you want to test. To optimize your code you could first check how many rows are filled with data. To do so you can use:
DIM lastrow as long
lastrow = Cells(Rows.Count, "B").End(xlUp).Row
And then make the loop with For N Is 2 to lastrow
Also it is good practice to explicitly reference your worksheets, as this prevents undesired results. For example you click on another worksheet whilst the code is running it will continue formatting on that sheet. To do so declare a variable as your worksheet:
DIM ws as worksheet
And set a value to your variable, in this case Sheet1.
Set ws as ThisWorkbook.Worksheets("Sheet1")
Now every time you reference a Cells(), you explicitly say on what sheet that has to be by adding ws. in front of it like such: ws.Cells()
To summarize all that into your code:
Sub CAPS()
'
' CAPS Macro
'
Dim N as long 'use long here as integer is limite to a 32b character
Dim lastrow as long
Dim ws as worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'Set the code to run on Sheet 1 of your current workbook.
lastrow = ws.Cells(Rows.Count, "B").End(xlUp).Row
For N Is 2 to lastrow ' Do all rows that have data in column B
If ws.Cells(N, 14) = 5 Then
ws.Cells(N, 2) = LCase(ws.Cells(N,2)
Else
ws.Cells(N, 2) = UCase(ws.Cells(N,2)
EndIf
Next N
End Sub
Try processing in an array,
Sub CAPS()
'
' CAPS Macro
'
Dim arr As variant, j As Integer
with worksheets("sheet1")
arr = .range(.cells(2, "B"), .cells(.rows.count, "B").end(xlup).offset(0, 12)).value2
for j= lbound(arr, 1) to ubound(arr, 1)
if arr(j, 13) = 5 then
arr(j, 1) = lcase(arr(j, 1))
else
arr(j, 1) = ucase(arr(j, 1))
end if
next j
redim preserve arr(lbound(arr, 1) to ubound(arr, 1), 1 to 1)
.cells(2, "B").resize(ubound(arr, 1), ubound(arr, 2)) = arr
end with
End Sub
You may try something like this...
Sub CAPS()
Dim ws As Worksheet
Dim lr As Long, i As Long
Application.ScreenUpdating = False
Set ws = Sheets("Sheet1") 'Sheet where you have to change the letter case
lr = ws.Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To lr
Select Case ws.Cells(i, "N")
Case 5
ws.Cells(i, "B") = LCase(ws.Cells(i, "B"))
Case Else
ws.Cells(i, "B") = UCase(ws.Cells(i, "B"))
End Select
Next i
Application.ScreenUpdating = True
End Sub
Another approach using for each loop with Range:
Sub UCaseLCase()
Dim rng, cell As Range
Dim Test As Integer
Test = 5
Set rng = Range(Cells(2, 14), Cells(10000, 14))
For Each cell In rng.Cells
If cell.Value = Test Then
cell.Offset(0, -12) = LCase(cell.Offset(0, -12))
Else
cell.Offset(0, -12) = UCase(cell.Offset(0, -12))
End If
Next cell
End Sub
I know you said in your question starting at row 2 but it's easier just going from last row until row 2.
Hope this can help or at least, learn something new about Loops :)
Sub CAPS()
Dim j As Integer
For j = Range("B2").End(xlDown).Row To 2 Step -1
If Range("N" & j).Value = 5 Then
'uppercase
Range("B" & j).Value = UCase(Range("B" & j).Value)
Else
'lowercase
Range("B" & j).Value = LCase(Range("B" & j).Value)
End If
Next j
End Sub
I need to be able to loop through my rows (specifically, column B), and use the number in a certain cell in order to do specific functions using other cells in that row. For example, Rule #1 indicates that I need to find last modified date of the path in the cell next to the Rule #, but the task is different for each Rule.
I'm new to VBA and I've just been struggling with setting up a loop and passing variables to different subs, and would hugely appreciate any help. To be clear, I'm looking for syntax help with the loop and passing variables
Thank you!
Reference Images: The spreadsheet
The attempt at sketching out the code
Private Sub CommandButton1_Click()
Dim x As Integer
NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
Range("B2").Select
For x = 1 To NumRows
If Range(RowCount, 1).Value = 1 Then
RuleOne (RowCount)
End If
Next
'Dim RowCount As Integer
'RowCount = 1
'Worksheets("Sheet2").Cells(1, 2) = Worksheets("Sheet1").UsedRange.Row.Count
'While RowCount < Worksheets("Sheet1").Rows
'If Worksheets("Sheet1").Cells(RowCount, 1).Value = 1 Then
'RuleOne (RowCount)
'End If
'Wend
End Sub
Sub RuleOne(i As Integer)
'use filedatetime and path from i cell
'Worksheets("Sheet2").Cells(1, 1) = FileDateTime(C, i)
Worksheets("Sheet2").Cells(1, 1) = "hello"
End Sub
Sub RuleTwo(i As Integer)
Worksheets("Sheet2").Cells(1, 1) = "hello"
End Sub
Try to change the Range(RowCount, 1).Value = 1 to Cells(x, 2).Value = 1.
The variable RowCount has not been initialised/set.
I assume this is what this variable is meant to be the number in column B
RowCount = Cells(x, "B").Value
I also noticed that the variable NumRows seemed to be one less than it should be (so if the last row was 1 it would skip it). So I used this instead:
NumRows = Cells(Rows.Count, "B").End(xlUp).Row
So try this code:
Sub CommandButton1_Click()
Dim x As Integer
NumRows = Cells(Rows.Count, "B").End(xlUp).Row
For x = 1 To NumRows
RowCount = Range("B" & x).Value
If RowCount = 1 Then
RuleOne (x)
End If
Next
'Dim RowCount As Integer
'RowCount = 1
'Worksheets("Sheet2").Cells(1, 2) = Worksheets("Sheet1").UsedRange.Row.Count
'While RowCount < Worksheets("Sheet1").Rows
'If Worksheets("Sheet1").Cells(RowCount, 1).Value = 1 Then
'RuleOne (RowCount)
'End If
'Wend
End Sub
Sub RuleOne(i As Integer)
'use filedatetime and path from i cell
'Worksheets("Sheet2").Cells(1, 1) = FileDateTime(C, i)
Worksheets("Sheet2").Cells(1, i) = "hello"
End Sub
Sub RuleTwo(i As Integer)
Worksheets("Sheet2").Cells(1, 1) = "hello"
End Sub
I need to find the first empty row number after the given row number.
please check the image below
for e.g: assume, my current row number is 6 then my output should be 10.
Something like this?
function FindFirstEmpty(i as long)
while cells(i,1).value <> ""
i = i + 1
wend
FindFirstEmpty = i
End function
Depends how you are obtaining the row from which to begin.
Dim startRow As Long
Dim i As Long
Dim lastRow As Long
Dim sh As Worksheet
startRow = 2 'Set first row to check
Set sh = ThisWorkbook.Worksheets("Sheet1")
lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
For i = startRow To lastRow
If sh.Cells(i, 1) = "" Then
MsgBox "First empty row: " & i
Exit For
End If
Next i
Have you tried something like this?
Note: This won't show you when the last row is empty.
I use CountA to see if the entire row is empty.
Function FirstEmtpyRow(startRow As Long) As Long
Do
startRow = startRow + 1
If startRow = rpws.Count Then Exit Function
Loop Until WorksheetFunction.CountA(Rows(startRow)) = 0
FirstEmtpyRow = startRow
End Function
You can use .End(xlDown) but you have to be careful that the immediately next cell is not blank or you could skip over it.
dim rw as long, nrw as long
rw = 6
with worksheets("sheet1")
with .cells(rw, "A")
if IsEmpty(.Offset(1, 0)) then
nrw = rw + 1
else
nrw = .end(xldown).offset(1, 0).row
end if
end with
end with
debug.print nrw
I have a macro which looks at a range of cells. Every other cell is either a 1 or a 0 (sign bit). Depending on the sign bit, the next cell (a normal number) is multiplied either by 1 or 0. I keep getting a run time error 1004 Application-defined or object-defined error on the body of the ElseIf of the If statement (indicated below). Not sure what I'm doing wrong. My code is in a "proof-of-concept" stage so it's still pretty hackish.
Dim N As Long
------------------------------------------
Private Sub CommandButton1_Click()
Dim x As Integer
Dim y As Integer
x = 0
y = 1
N = Application.InputBox(Prompt:="Enter value", Type:=1)
If N > Columns.Count Then
N = Columns.Count
Else
For i = 4 To 9999
Cells(1, i).ClearContents
Cells(3, i).ClearContents
Next i
End If
For i = 4 To N + 3
x = x + y
Cells(1, i) = x
Next i
For i = 4 To N + 3
If Cells(2, i) = 1 Then
Cells(2, i).Offset(0, 1).Select = Cells(2, i).Offset(0, 1).Select * -1
ElseIf Cells(2, i) = 0 Then
'This is the line with errors vvvvvvvvvvvvvvvvv
Cells(2, i).Offset(0, 1).Select = Cells(2, i).Offset(0, 1).Select * 1
End If
Next i
End Sub
That's because you're using Select. Obviously, Select and Activate don't give you values. They select or activate the cell, not different from manually clicking on them using the mouse or moving/activating to them using the keyboard or what else. Multiplying them by a value is a major no-no.
The Range property you should be looking for is Value. In any case, I think you're making it difficult because of having two loops. You really should reconsider your design pattern. In any case, here's my approach (mine's vertical, but it seems like yours is horizontal, so be clear exactly what is on your end so this can be adjusted).
Private Sub CommandButton1_Click()
Dim WS As Worksheet
Dim LastRow As Long
Dim Iter As Long
Dim CurrCell As Range
Const Col = 1
With ThisWorkbook
Set WS = .Sheets("Sheet3") 'Change as necessary.
End With
With WS
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For Iter = 1 To LastRow 'Change as necessary.
Set CurrCell = .Cells(Iter, Col)
Select Case CurrCell.Value
Case 1
CurrCell.Offset(0, 1).Value = (CurrCell.Offset(0, 1).Value * (-1))
Case 0
CurrCell.Offset(0, 1).Value = (CurrCell.Offset(0, 1).Value * 1) 'Is this even necessary? It's an identity.
End Select
Next
End With
End Sub
Screenshot:
Let us know if this helps.