Following on from my previous question, I would now like to copy paste values within a cell range.
The code used in my previous query was;
Sub CopyYesInW()
Dim lastRow As Long, i As Long
'determine last row in column W
lastRow = Cells(Rows.Count, "W").End(xlUp).Row
For i = 1 To lastRow
'if Yes in W then copy from P to W in current row
If Cells(i, "W").Value = "Yes" Then
Cells(i, "P").Value = Cells(i, "P").Value
End If
If Cells(i, "W").Value = "Yes" Then
Cells(i, "U").Value = Cells(i, "U").Value
End If
Next
End Sub
I have amended the code in the script below to check the the cell range C6:N6 for values = Yes then copy paste values over the cells in C9:N9. However I am not sure what I am doing wrong. There is a runtime error '5' invalid procedure call or argument
Sub CopyYesInForecast()
Dim lastRow As Long, i As Long
'determine last row in column W
lastRow = Cells("C6")
For i = 1 To lastRow
'if Yes in W then copy from P to W in current row
If Cells(i, "C6:N6").Value = "Yes" Then
Cells(i, "C9:N9").Value = Cells(i, "C9:N9").Value
End If
Next
End Sub
While your narrative is thin, perhaps this is close to what you are attempting.
Sub CopyYesInForecast()
Dim c As Long
For c = range("C:C").column to range("N:N").column
If Cells(6, c).Value = "Yes" Then
Cells(9, c) = Cells(6, c).Value
End If
Next
End Sub
This looks through row 6, column C to N and if it finds Yes then it transfers the value to the same column in row 9.
Related
Help me to add loop to below code. As of now code copies only first match from text in cell -"26002354". I want it to copy all matches from one cell and than it goes to next cell down.
Lets say - in text i have tree matches(all text in one cell):
26002354
26008541
26009841
All of them i need to get in a row on the right.
Sub extract()
Dim r As Long, dashpos As Long, m As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
m = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For r = 2 To m
dashpos = InStr(1, Cells(r, 1), "2600")
Cells(r, 2).Value = Mid(Cells(r, 1), dashpos, 14)
Cells(r, 3).Value = Mid(Cells(r, 1), dashpos, 14)
Cells(r, 4).Value = Mid(Cells(r, 1), dashpos, 14)
Next
End Sub
Your intended result is a little unclear but to get three 8 digit numbers in columns B:D from columns A containing '26002354 26008541 26009841', use Split.
Sub extract()
Dim r As Long
with Worksheets("Sheet1")
For r = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(r, 2).resize(1, 3) = split(Cells(r, 1).value2, chr(32))
Next
end with
End Sub
I have a sheet full of data, from to the column A to column G.
How can a VBA Macro:
copy rows (not the entire row, only the column A,B,C,D,E) if the value in C<>"CLOSE" and the value in B is <19:00 And >00:00.
Edit:
I tried this solution, but when I run it, I don't find any selected cells.
Dim r As Range, N As Long
Set r = Intersect(ActiveSheet.UsedRange, Range("B:C"))
N = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To N
cc = Cells(i, 2).Value
dd = Cells(i, 3).Value
If cc >= "19:00" And cc < "00:00" And dd <> "Close" Then
ActiveSheet.Range(Cells(i, 1), Cells(i, 2), Cells(i, 3), Cells(i, 4), Cells(i, 5)).Select
End If
Next i
I've already tried to use the letters instead of the numbers to indicate the columns (...Cells(i,A) instead of Cells(i,1)) but it doesn't work.
Thanks.
Try this code:
Sub CopyRows()
Dim lastRow As Long, i As Long, time As Variant
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To lastRow
If Cells(i, 3) = "CLOSE" Then GoTo SkipLoop
'extract just hour and see if it's less than 19
If CInt(Left(Cells(i, 2), 2)) < 19 Then GoTo SkipLoop
Range(Cells(i, 1), Cells(i, 5)).Select
SkipLoop:
Next
End Sub
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've what seems like a pretty simple application with looping and 'If..Then' statements but need some help on structuring it.
In very a basic example, I have a list numbers in column A and the values PM or AM listed in column B. I want to write a loop that will search every value in column B until the end of the data set, and add 12 to each value in column A each time column B has a value of PM. In a nutshell, it would look like this:
If column B = PM
then add 12 to its corresponding cell in column A
else move down to the next row and do the same thing until you reach an empty cell
There are many ways, here is a typical one:
Sub dural()
Dim i As Long
i = 1
Do While Cells(i, "B").Value <> ""
If Cells(i, "B").Value = "PM" Then
Cells(i, "A").Value = Cells(i, "A").Value + 12
End If
i = i + 1
Loop
End Sub
you can set it with For next loop and 2 variables. one for last row and the 2nd for the row count:
Sub Macro1()
Dim LastRow As String
Dim i As Integer
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If Cells(i, 2).Value = "PM" Then Cells(i, 1).vlaue = Cells(i, 1).vlaue + 10
Next i
End
'
End Sub
This is another way to do this.
Option Explicit
Sub Add()
Dim rData As Range
Dim r As Range
Set rData = Cells(1, 1).CurrentRegion.Columns("B").Cells
For Each r In rData
If UCase$(r.Value) = "PM" Then
r.Offset(, -1).Value = r.Offset(, -1).Value + 12
End If
Next r
End Sub
I want to copy data from one sheet to another with few conditions:
1. Start with row 1 and column 1 and match if the R1 C2 is not empty then copy the pair R1 C1 and R1 C2 and paste into the other sheet as a new row.
increment the counter for column and match R1 C1 with R1 C3 and so on.
increment the Row when the column counter reaches 10.
I tried the below code but gives compile error as Sub or function not defined.
Please help.
Private Sub CommandButton1_Click()
Dim x As Integer
Dim y As Integer
x = 2
y = 2
Do While Cells(x, 1) <> ""
If Cells(x, y) <> "" Then
Worksheets("Sheet1").Cells(x, 2).Copy
Worksheets("Sheet2").Activate
erow = Sheet2.Cells(Rows.Count, 1).End(xlUp) > Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet2").Rows(erow)
End If
Worksheets("Sheet1").Activate
y = y + 1
If y = 10 Then x = x + 1
End If
Loop
End Sub
You are geting that error because of > in Sheet2.Cells(Rows.Count, 1).End(xlUp) > Offset(1, 0).Row
Avoid the use of using Integer when you are working with rows. Post excel2007, the row count has increased and the Integer may not be able to handle the row number.
Avoid the use of .Activate.
Is this what you are trying? (Untested)
Note: I am demonstrating and hence I am working with the excel cells directly. But in reality, I would be using autofilter & arrays to perform this operation.
Private Sub CommandButton1_Click()
Dim wsInput As Worksheet, wsOutput As Worksheet
Dim lRowInput As Long, lRowOutput As Long
Dim i As Long, j As Long
Set wsInput = ThisWorkbook.Worksheets("Sheet1")
Set wsOutput = ThisWorkbook.Worksheets("Sheet2")
With wsInput
lRowInput = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To lRowInput
If .Cells(i, 2).Value <> "" Then
For j = 3 To 10
lRowOutput = wsOutput.Range("A" & wsOutput.Rows.Count).End(xlUp).Row + 1
.Range(.Range(.Cells(i, 1), .Cells(i, 1)).Address & _
"," & _
.Range(.Cells(i, j), .Cells(i, j)).Address).Copy _
wsOutput.Range("A" & lRowOutput)
Next j
End If
Next i
End With
End Sub