I need a macro to cut and paste a portion of a string from column A to column B if the string has a - sign in the 9th character. I found some code on stackoverflow that will copy/paste the text portion but does not cut/paste. My data looks like this
SUBIAIUP-456253
SUBIAIUP-254
Here's the code I have so far:
Public Sub LeftSub()
Dim cell As Range
Dim sourceRange As Range
Set sourceRange = Sheet1.Range("A1:A180")
For Each cell In sourceRange
If Mid(cell.Value, 9, 1) = "-" Then
'this code should cut/paste the value from col A to col B, not copy/paste
Sheets("Sheet1").Range("B" & cell.Row).Value = Mid(cell.Value, 9, 20)
End If
Next
End Sub
Any help is much appreciated.
Thank you.
If you want the value you are pasting into column B removed from column A, use this:
If Mid(cell.Value, 9, 1) = "-" Then
cell.Offset(, 1).Value = Mid(cell.Value, 9)
cell.Value = Left(cell, 8)
End If
As Sid and Brett point out, we don't need the number of characters argument for the Mid function if we are getting the rest of the value from the midpoint on. If you want the dash at the start of your Column B value, set the midpoint to 9. If you want to omit it, set it to 10.
If you want to cut/paste the entire value from column A to B, use this:
If Mid(cell.Value, 9, 1) = "-" Then
'this code WILL cut/paste the value from col A to col B, not copy/paste
cell.Cut cell.Offset(, 1)
End If
Related
Starting in cell B8, I want to count the number of rows down until we hit a cell that is filled with the RGB 93, 123, 157.
I tried using the autofill formula feature while recording, but the cell references stayed absolute: Selection.AutoFill Destination:=ActiveCell.Range("A1:A182")
This will only work if the report has 182 rows, which they won't all have.
I was also given this to try:
Sub Test()
Dim i As Long, bluerow As Long
For i = 1 To 10000
If Cells(i, 2).Interior.Color = RGB(93, 123, 157) Then
bluerow = i
Exit For
End If
Next i
Range("B6").AutoFill Destination:=Range("B6:B" & bluerow), Type:=xlFillDefault
End Sub
But it doesn't put any numbers in column B.
This could work by itself.
Sub NumRws()
'"Cells(5, 2)" is a reference to B5(for some reason, shouldn't it be B8? in that case it should say "Cells(8, 2)")
'"Cells(Rows.Count, 1).End(xlUp)" refers to the last used cell(a cell with any value) in column A
'".Offset(-1, 1)" offsets the second reference to column B and now also one row up("-1,")
'..and "Range(...)" combines the two
'".FormulaR1C1 = "=ROW()-4"" applies the formula which results in row number minus 4(if you change to B8 it should be -7)
Range(Cells(5, 2), Cells(Rows.Count, 1).End(xlUp).Offset(-1, 1)).FormulaR1C1 = "=ROW()-4"
'..Also if you just want the result of the formula do the following instead
With Range(Cells(5, 2), Cells(Rows.Count, 1).End(xlUp).Offset(-1, 1))
.FormulaR1C1 = "=ROW()-4"
.Value = .Value
End With
End Sub
The code below uses Find to get the first cell in column B that matches the color criteria, and then subtracts 7 from the row number.
Sub FindtheFirstColoredCellCountRowsfromRow8()
'Find the first cell in Column(2) with specific interior color and count number of rows
Dim fndCel As Range, cnt As Long
ActiveCell.Interior.Color = RGB(93, 123, 157) 'colors any cell to use in "Find"
Application.FindFormat.Interior.Color = ActiveCell.Interior.Color 'store cell color in find
'set the find range variable to find the first cell that matches the color in Column B
Set fndCel = ActiveSheet.Columns(2).Find("", , , , , xlNext, , , True)
cnt = fndCel.Row - 7 'set the count variable by subtracting 7 from the fndCell row
MsgBox cnt
Application.FindFormat.Clear 'reset FindFormat
ActiveCell.Interior.Color = xlNone 'clear the cell you used to set the color to find
End Sub
Not exactly sure what you're asking for? You want the row number to appear on every cell from B8 till the row where it appears? in that case use:
range("B8:B" & bluerow) = bluerow
This will type the row number where the RGB value is found, starting from B8, down to where the RGB was found. If this is not what you need please explain your problem further.
EDIT: Oh, my bad. Then use this:
For i = 1 To 10000
If Cells(7 + i, 2).Interior.Color = RGB(93, 123, 157) Then
Exit For
Else
Cells(7 + i, 2) = i
End If
Next i
I would suggest finding the last row, though, instead of using "to 10000", you can use:
LastRow = cells(rows.count,2).end(xlup).row
I am looking for a way to extract text between 2 characters and copy them to a column at the end of the spreadsheet.
For example, my text looks like [abcdefg], all in Column A, I am looking to extract the text between the "[" and copy it to a new column at the end of the worksheet (as a new column)
Thanks
I would resort to functions since they're just the easiest. To pull the data between 2 characters, you'd use a mixture of MID and FIND functions.
So, assuming your data was in cell A1, you could put this formula in the cell where you want the parsed value:
=MID(A1,FIND("[",A1)+1,FIND("]",A1)-FIND("[",A1)-1)
If you wanted to automate it, you could put it into a macro then copy / paste-special values to remove the function and keep the values.
This is for text in Cell 1, 1 but you can toss some variables in there as you loop through your rows. It will grab the values within square brackets & trim it, additional text can be in front or behind the brackets.
Dim iPos1 As Integer
Dim iPos2 As Integer
iPos1 = InStr(Sheet1.Cells(1, 1), "[")
iPos2 = InStr(Sheet1.Cells(1, 1), "]")
Sheet1.Cells(1, 2) = Trim(Mid(Sheet1.Cells(1, 1), iPos1 + 1, iPos2 - iPos1 - 1))
If you want to write this into a vba module, looping through all entries in the A column and extracting the text inside the [] into an entry in column B, it might look something like:
Dim ws as Worksheet
Dim i as integer
Dim lastRow as Integer
Dim brack1pos as Integer
Dim brack2pos as Integer
Set ws = ThisWorkbook.Worksheets("My Sheet Name")
for i = 1 to lastRow 'I'll leave to you how to find the last row
brack1pos = InStr(ws.Range("A" & i), "[")
brack2pos = InStr(ws.Range("A" & i), "]")
ws.Range("B" & i) = Trim(Mid(ws.Range("A" & i), brack1pos + 1, brack2pos - brack1pos - 1))
next
I have a spreadsheet with a load of random text and numbers in column A like so:
Column A
Row 1 = 471806121601 5205569 - 0007 Standard White Toilet Tissue 27
Row 2 = 471814121601 5206177 - 0014 Premium White Toilet Tissue 6
Row 3 = 471814121601 5206178 - 0007 Premium White Toilet Tissue 27
Row 4 = 471806121601 5206180 - 0014 Premium Kitchen Towel 2x75l 6
I have about 2000 lines in total. In each cell, is a Purchase order number (12 digits) and an item number next to it (7 digits).
I am trying to extract the po number and put it into column B and extract the item number and put it into column C
Column B Column C
471806121601 5205569
471814121601 5206177
471814121601 5206178
471806121601 5206180
Here is my code:
Option Explicit
Sub main()
Dim cell As Range
Dim arr As Variant, arrElem As Variant
With Worksheets("Orders") '<--| change "Strings" to your actual worksheet name
For Each cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
arr = Split(Replace(cell.Value, " ", " "), " ") '<--| change "A"'s to your actual relevant column index
For Each arrElem In arr
If IsNumeric(arrElem) Then
If Len(arrElem) = 12 Then cell.Offset(0, 1).Value = arrElem
End If
Next arrElem
Next cell
End With
Dim cell2 As Range
Dim arr2 As Variant, arrElem2 As Variant
With Worksheets("Orders") '<--| change "Strings" to your actual worksheet name
For Each cell2 In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
arr2 = Split(Replace(cell2.Value, " ", " "), " ") '<--| change "A"'s to your actual relevant column index
For Each arrElem2 In arr2
If IsNumeric(arrElem2) Then
If Len(arrElem2) = 7 Then cell2.Offset(0, 3).Value = arrElem2
End If
Next arrElem2
Next cell2
End With
End Sub
This code does work. However it takes absolutely ages and only does one line at a time...Slowly.
Is there a quicker way of doing this? Thanks
If your PO and IN are always the same length in col B put
=MID(A2, 1, 12)
And in col C
=MID(A2, 14, 7)
However if your number change but are always the first two swap the above for,
=MID(A2,1,FIND(" ",A2,1)-1)
And
=MID(A2, FIND(" ", A2, 1)+1, 7)
Respectively.
just use split(string,delimiter)(0) and (1) why replace the space, just use that as the delim. If Row # is in, then use (1) and (2), or you could consider split(split(input,"-")," ") maybe a little faster, not sure though. Also, once you're done no need to complete the loop, so consider, do until with flags rather than for next, although exit for is available
Formula wise, it could be done using something like this
=MID(D1,FIND("é",SUBSTITUTE(D1," ","é",3)),FIND("é",SUBSTITUTE(D1," ","é",4))-FIND("é",SUBSTITUTE(D1," ","é",3)))
and
=MID(D1,FIND("é",SUBSTITUTE(D1," ","é",4)),FIND("é",SUBSTITUTE(D1," ","é",5))-FIND("é",SUBSTITUTE(D1," ","é",4)))
I have files of data with the following format:
In column A, identifiers occur either doubly (e.g. 302_60) or singularly (e.g.310_58). Additional information is present in column B.
What I want to do is:
tag the rows that have single identifiers in column A with
TRUE/FALSE in Column C
for any TRUE tag, insert a line BELOW
copy into the inserted row the contents of the ENTIRE tagged row (here just columns A,B)
I solved #1 using =COUNTIF(A:A, A1)=1
I then wrote a VBA script to solve #2
Sub ins_below_and_copy()
Dim c As Range
For Each c In Range("C1:C100")
If InStr(1, c, "TRUE", vbTextCompare) > 0 Then
Rows(c.Offset(1, 0).Row & ":" & c.Offset(1, 0).Row).Insert Shift:=xlDown
End If
Next c
End Sub
Achieving the desired end result (#3)
seems simple enough, right? I have been trying .Copy and .Paste commands, but keep getting type-mismatch errors, an error that does not make sense to me (since I am not a competent VBA coder). Any ideas?
You have down all the hard work, filling in the gaps is easy. Select the two columns, HOME > Editing - Find & Select, Go To Special..., Blanks, OK, =, UP and Ctrl+Enter.
You can run this after you have your empty rows created.
Dim sheet As String
Dim lastRow As Long
sheet = "SheetName"
lastRow = Sheets(sheet).Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To lastRow 'Assuming you have a Header Row
If Sheets(sheet).Cells(r, 1) = "" Then
Sheets(sheet).Cells(r - 1, 3) = "FALSE"
Sheets(sheet).Cells(r, 1) = Sheets(sheet).Cells(r - 1, 1)
Sheets(sheet).Cells(r, 2) = Sheets(sheet).Cells(r - 1, 2)
Sheets(sheet).Cells(r, 3) = Sheets(sheet).Cells(r - 1, 3)
End If
Next r
I've got a workbook where I have one worksheet which contains a lot of data.
My goal is to create a macro that inserts a formula in a separate sheet to copy the data from the first sheet. Lets call the first sheet "Numbers1" and the second sheet "TidyNumbers1".
In the sheet "TidyNumbers1" I want to loop through each cell from column A to M and rows 1 to 60. So I've got a macro that so far looks like this:
Sub updateFormulasForNamedRange()
Dim row, col, fieldCount As Integer
colCount = 13
RowCount = 60
For col = 1 To colCount
For row = 1 To RowCount
Dim strColCharacter
If col > 26 Then
strColCharacter = Chr(Int((row - 1) / 26) + 64) & Chr(((row - 1) Mod 26) + 65)
Else
strColCharacter = Chr(row + 64)
End If
Worksheets("TidyNumbers1").Cells(row, col).Formula = "=IF(Numbers1!E" & col & "<>0;Numbers1!" & strColCharacter & row & ";"")"
Next row
Next col
End Sub
But the formula is supposed to looks like this for Column A, row 2:
IF(Numbers1!E2<>0;Numbers1!A2;"")"
And the formula in Column A, row 3 should look like this:
IF(Numbers1!E3<>0;Numbers1!A3;"")"
Formula in Column B, row 2 should look like this:
IF(Numbers1!E2<>0;Numbers1!B2;"")"
In other words, the formula looks to see if the value in Column E, row % is anything but 0 and copies it if conditions are met.
But, I see that I need to translate my integer variable Row with letters, because the formula probably needs "A" instead of 1. Also, I get a 1004 error (Application-defined or object-defined error) if I just try to use:
Worksheets("Numbers1").Cells(row, col).Formula = "=IF(Numbers1!E" & row & "<>0;Numbers1!" & col & row & ";"")"
I clearly see that the integer row should be translated to letters, if that's possible. Or if anyone has any other suggestions that might work. Also, the 1004 error is unclear to me why happens. I can define a string variable and set the exact same value to it, and there's no error. So it's probably the formula bar that whines about it I guess?
Here is a former post of mine containing functions for conversion of column numbers to letters and vice versa:
VBA Finding the next column based on an input value
EDIT: to your 1004 error: Try something like this:
=IF(Numbers1!E" & row & "<>0,Numbers1!A" & row & ","""")"
(use ; instead of ,, and "" for one quotation mark in a basic string, """" for two quotation marks).
Would not it be easier to get the cell address with the Cells.Address function?
For example:
MsgBox Cells(1, 5).Address
Shows "$E$1"
Best Regards