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
Related
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
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.
I have the below code that pulls out specific data from the spreadsheet and formats it into a table. Both for loops work, however the first one will only work if I'm on Sheet1 and the second one will only work if I'm on Sheet2.
I can't work out how to rewrite it to make both sections of code work anywhere in the spreadsheet. Preferably from Sheet1 if it had to be.
Sub MakeMyTable()
Dim Col As Variant
Dim Col2 As Variant
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long
Col = "D"
Col2 = "A"
StartRow = 1
X = 3
'This with pulls the formatted data into totals into Sheet2
With Sheets("Sheet1")
LastRow2 = Cells(Rows.Count, Col).End(xlUp).Row
For R = StartRow + 1 To LastRow2 + 1 Step 1
If .Cells(R, Col) = "" Then
Sheets("Sheet2").Cells(1, "A").Value = "Project Cost Centers Costs At " & Date
Sheets("Sheet2").Cells(X, "A").Value = .Cells(R - 1, Col).Value
Sheets("Sheet2").Cells(X, "B").Value = .Cells(R - 1, "F").Value
Sheets("Sheet2").Cells(X, "C").Value = .Cells(R, "P").Value
Sheets("Sheet2").Cells(X, "C").NumberFormat = "$#,##0.00"
X = X + 1
End If
Next R
End With
' This with finds any cell that has "RX04F.029.038" in it and moves it to the
' bottom of the table.
With Sheets("Sheet2")
LastRow2 = Cells(Rows.Count, Col2).End(xlUp).Row
For R = LastRow2 To StartRow + 2 Step -1
If InStr(1, Cells(R, Col2).Value, "RX04F.029.038") > 0 Then
Rows(R).Cut
Rows(LastRow2 + 1).Insert Shift:=xlDown
R = R + 1
LastRow2 = LastRow2 - 1
End If
Next R
End With
End Sub
You also need to properly link your With statement to the ranges you use. For example, you have With Sheets("Sheet2") but them don't link the lastRow2 = Cells().Row to it. Do this for all such instances: LastRow2 = .Cells(.Rows.Count,Col2).End(xlUp).Row. Otherwise, any use of a range will occur on the ActiveSheet, whatever that may be. – BruceWayne 3 mins ago
Edit: BruceWayne gave me the answer I need in the comments but cant mark it as an answer so this is the best I could do. Thank you
You can change the sheet names to what you want.
Or you can swap:
With Sheets("Sheet1")
for
With ActiveSheet
if you want to run the loops on the active sheet.
I am trying to write code that would shift the range of cells from the current cell till the last cell that has data in the row one cell to the right if the relative cell that contains the weekday has the values fri or sat.
My code is below, however when it runs, Excel would not respond and restarts by itself. I don't really know where the problem is.
Note: i is the row index, j is the column index
Sub shiftcell()
Dim i As Integer
Dim j As Integer
Dim lcol As Integer
Dim rng As Range
For i = 8 To 18
For j = 6 To 70
If (Sheets("master").Cells(6, j).Value = "Fri" Or
Sheets("master").Cells(6, j).Value = "Sat") Then
lcol = Sheets("MASTER").Cells(i, Columns.COUNT).End(xlToLeft).Column
Set rng = Range(Cells(i, j), Cells(i, lcol))
rng.Cut rng.Cells(i).Offset(0, 1)
End If
Next j
Next i
End Sub
This should work for you (you can omit the second loop over the rows by selecting the whole range at once, as long as the rows have the same length. Otherwise bring back the row loop but inside the if environement):
Sub shiftcell()
Dim j, lcol As Long
Dim rngFrom, rangeTo As Range
For j = 6 To 70
If ((Sheets("master").Cells(6, j).Value = "Fri") Or (Sheets("master").Cells(6, j).Value = "Sat")) Then
lcol = Sheets("master").Cells(8, Columns.Count).End(xlToLeft).Column
If (lcol >= j) Then
Set rngFrom = Range(Cells(8, j), Cells(18, lcol))
Set rngTo = Range(Cells(8, j + 1), Cells(18, lcol + 1))
rngFrom.Cut rngTo
End if
End If
Next j
End Sub