I am trying to identify a column which has a special sort of string in it. For simplicity of the question here is a small sample size of the column I am working with.
The column contains names of people, but we see some records have a special key id in the last 7 to 8 digits of the cell. The one I am interested in are the ones that start with an uppercase "C" followed by 6 numeric digits.
I am trying to get results similar to this.
Column B (Cab ID) just takes the 7 digits from the right, which is easily done by excel functions in vba. I am trying to get column C (Flag), where I identify whether they are the records that I am interested in, which are the ones which start with an uppercase "C" and are followed by 6 numeric digits. If they are, I mark them down as "Y" else "N".
If any extra details needs to be added, let me know and I will make a quick edit as soon as possible to the question.
Without RegExp
Checks if the first of the last seven chars is capital "C". If so, checks if the last 6 chars are numeric. Only then returns "Y".
The Code
Sub LeftRightArray()
Const cSheet1 As Variant = "Sheet1" ' Sheet Name/Index
Const cFirst As Integer = 2 ' Source First Row
Const cSourceC As Variant = "A" ' Source Column
Const cTargetC As Variant = "B" ' Target Column
Const cSearch As String = "C" ' Search String
Dim lastR As Long ' Source Last Row Number
Dim i As Long ' Array Row Counter
Dim j As Integer
Dim vnt As Variant ' Array
Dim strCompare ' Compare String
' Paste Source Range into Array
With Worksheets(cSheet1)
lastR = .Cells(.Rows.Count, cSourceC).End(xlUp).Row
vnt = .Range(.Cells(cFirst, cSourceC), .Cells(lastR, cSourceC))
End With
' Change data in Array.
For i = 1 To UBound(vnt)
' Check if C is the first char of last 7 chars.
If Left(Right(vnt(i, 1), 7), 1) = cSearch Then
' Check if last 6 chars are numeric.
If IsNumeric(Right(vnt(i, 1), 6)) Then
vnt(i, 1) = "Y"
Else
vnt(i, 1) = "N"
End If
Else ' C is not the first letter of last 7 chars.
vnt(i, 1) = "N"
End If
Next
' Paste Array into Target Range
With Worksheets(cSheet1).Cells(cFirst, cTargetC)
.Resize(UBound(vnt), UBound(vnt, 2)) = vnt
End With
End Sub
Use the following formula in column C:
=IFERROR(IF(AND(MID(A2,FIND("*",A2)+1,1)="C",LEN(A2)-(FIND("*",A2)+1)=6),"Y","N"),"N")
Alternative:
Put this formula in column B
=IFERROR(IF(AND(MID(A2,FIND("*",A2)+1,1)="C",LEN(A2)-(FIND("*",A2)+1)=6),MID(A2,FIND("*",A2)+1,7),""),"")
and this formula in columnC
=IF(LEN(B2)<>0,"Y","N")
You can directly use the below excel formula as well. This formula can be used in VBA code after little modification.
=IF(COUNT(FIND({0,1,2,3,4,5,6,7,8,9},A2))=0,"N",IF(EXACT(LEFT(B2,1),"C"),"Y","N"))
Note: A2 is the cell which contains your data, example: Joe*C5464647. Please refer snapshot.
Excel Snapshot with data
Related
am working on sheet and using the vba for the first time and i love it. but been stuck in one thing for the last few days, after all the reading and searching can not figure how to do this part, here is the scenario I have:
locked sheet and workbook, user can only edit/entre values (numbers) in cells C8:G8 and I8:X8, column H always blank and host no value.
the user is able to hide columns in C8:G8 and I8:X8 if he need to use certain number of columns.
trying to set a macro to identify if a value has been entered more then once within the entire range C8:X8 (excluding H it is empty and any other columns if hidden)
I started with countif and give the perfect results only if all columns are visible:
Sub dup()
Application.EnableEvents = False
Dim x As Variant 'tried with range
Dim n As Variant 'tried with range
Dim rng1 As Range 'tried with variant
Set rng1 = Range("C8:X8")
For Each x In rng1.SpecialCells(xlCellTypeVisible)
If Application.WorksheetFunction.CountIf(rng1, x) > 1 Then
x.Offset(4) = "3" 'used for conditional formatting
Else
x.Offset(4) = "10" 'used for conditional formatting
End If
Next
Application.EnableEvents = True
End Sub
still work when some columns are hidden but it does check through hidden columns and this is not what i want (i want it to skip hidden columns)
some search and reading find out the countif is unable to get the cell property if visible or hidden. tried both options application.countif and application.worksheetfunction.countif
so tried application.match but no luck
For Each x In rng1
If Not IsEmpty(x) Then
n = Application.match(x.Value, rng1.Value, 0)
If Not IsError(n) Then
x.Offset(4) = "3"
Else
x.Offset(4) = "10"
End If
End If
Next
tried application.hlookup and not able to get the desired result :
For Each x In rng1
If Not IsEmpty(x) Then
n = Application.HLookup(x.Value, rng1.Value, 1, False)
If Not IsError(n) Then
x.Offset(4) = "3"
Else
x.Offset(4) = "10"
End If
End If
Next
it will match the cell itself and look only in the first part of the range C8:G8.
just to explain about the hidden columns situation, the user can hide/show 1,2,3,4 and 5 columns in the first range (if user select 2, only columns C8:D8 will be visible) same apply for range I8:X8, if user select 5 only I8:M8 will be visible) so there will be a case where a hidden column will be in between visible columns.
find few answers on how to use SumProduct(subtotal,...) as a formula only and could not covert it to a VBA.
any recommendation and advise will be appreciated.
Please try this solution.
Sub Dup()
Const Sep As String = "|" ' select a character that
' doesn't occur in Rng
Dim Rng As Range
Dim Arr As Variant
Dim SearchString As String
Dim n As Integer
Dim i As Integer
' needed only if you have event procedures in your project:-
Application.EnableEvents = False
Set Rng = Range("C8:X8")
Arr = Rng.Value
SearchString = Sep
For i = 1 To UBound(Arr, 2)
If Not Columns(Rng.Cells(i).Column).Hidden Then
SearchString = SearchString & Arr(1, i) & Sep
End If
Next i
For i = 1 To UBound(Arr, 2)
' skip blanks, incl. column H, & hidden cells
If (Not Columns(Rng.Cells(i).Column).Hidden) And (Len(Arr(1, i)) > 0) Then
n = InStr(SearchString, Sep & Arr(1, i) & Sep)
n = InStr(n + 1, SearchString, Sep & Arr(1, i) & Sep)
With Rng.Cells(i)
If .Column <> 8 Then ' skip column H
.Offset(4).Value = IIf(n > 0, 3, 10)
' Note that "3" is a string (text) whereas 3 is a number
' It's unusual to enter a number as text because it's use
' for calculations is greatly impaired.
' However, you may modify the above line to write strings
' instead of numbers.
End If
End With
End If
Next i
Application.EnableEvents = True
End Sub
The sub assigns all non-hidden values in the Range to to an array and then reads them into a string (SearchString) in which they are separated by a special character which can be re-defined. All values exist in this string at least once. The second loop looks for the existing value which must be both followed and preceded by the special character because "a" would be found in "ab", "a|" in "ba|" but "|a|" is unambiguous. Then a second search (Instr), starting from after where the first match was found, determines if a duplicate exists. The Iif function then sets the value in the cell 4 rows below the examined cell. Note that the array index is identical to the cell number in the range because of the way the array was created.
Since the Instr function will "find" a null string in position 1 and consider it a duplication by default, null strings aren't processed, not setting any number for the purpose of CF. Column H should therefore be omitted. However, if column H should have any value the CF number will still not be written.
As the sub is called by an event procedure the Application's EnableEvents property should be set in that procedure, not in the sub. This is for greater clarity of the code and has no bearing on the functionality unless the vent procedure also calls other procs.
#Variatus, Sorry to get back on this, after further tests i think i found an issue, if i try to hide any clomun from range C8:G8 (ex : G8 and let say it has same value as M8) the Arr will only look through C8:F8 only, for some reason it doesn't go all the way to X8, and it will mark M8 as duplicate.
or even if the duplicate value is withing I8:X8 it wont find it because the Arr stop at the first hidden cell from the first range
any advise will be appreciated
As you can see in the image, there are some 1 and 0s rearranged in 3 rows and one English Alphabet for each column. What I need to do is concatenate the English Alphabets for each row when the respective column value is 0. How can I do it?
Here is a VBA solution that can handle any number of columns (assuming that the letter associated with each column is the standard column label):
Function ZeroColumns(R As Range) As String
Dim n As Long
Dim count As Long
Dim cols As Variant
Dim cell As Range
n = R.Cells.count
ReDim cols(1 To n)
For Each cell In R.Cells
If cell.Value = 0 Then
count = count + 1
cols(count) = Split(cell.Address, "$")(1)
End If
Next cell
ReDim Preserve cols(1 To count)
ZeroColumns = Join(cols, "")
End Function
The code shouldn't be too hard to tweak if the stated assumption doesn't hold.
Conditionally Concatenate Row (UDF)
Arguments
SourceRowRange: The range containing the values that will be
written toCCROW e.g. A, B, C ... Required.
CriteriaRowRange: The range that will be checked for
CriteriaValue. Required.
CriteriaValue: The value that the cells in CriteriaRowRange will
be checked against. Default is 0. Optional.
JoinString: The value that will be put between the values that will
be written to CCROW. Default is "". Optional.
' Copy the following code to a standard module i.e. in VBE go to Insert>Module.
The Code
Function CCROW(ByVal SourceRowRange As Range, ByVal CriteriaRowRange As Range, _
Optional ByVal CriteriaValue As Variant = 0, _
Optional ByVal JoinString As String) As String
Dim vntS As Variant ' Source Array
Dim vntC As Variant ' Criteria Array
Dim NoC As Long ' Number of Columns
Dim j As Long ' Arrays Column Counter
Dim strB As String ' String Builder
Dim strC As String ' Criteria String
' Calculate number of columns of the narrower Range.
NoC = WorksheetFunction.Min(SourceRowRange.Columns.count, _
CriteriaRowRange.Columns.count)
' Copy resized (adjust them to same size) Ranges to Arrays.
vntS = SourceRowRange.Resize(1, NoC)
vntC = CriteriaRowRange.Resize(1, NoC)
' Loop through columns of either Array.
For j = 1 To NoC
' Write current value of Criteria Array to Criteria String.
strC = vntC(1, j)
' Check if Criteria String is NOT empty.
If strC <> "" Then
' Check if Criteria String is equal to Criteria Value.
If strC = CriteriaValue Then
' Check if String Builder is NOT empty.
If strB <> "" Then ' NOT empty.
strB = strB & JoinString & vntS(1, j)
Else ' IS empty (only once).
strB = vntS(1, j)
End If
End If
End If
Next
' Write String Builder to Conditionally Concatenate Row.
CCROW = strB
End Function
Usage in Excel
=CCROW(A$1:I$1,A3:I3) ' Result: ADG
=CCROW(A$1:I$1,A4:I4) ' Result: CFI
=CCROW(A$1:I$1,A5:I5) ' Result: DG
If you add JoinString:
=CCROW(A$1:I$1,A3:I3,,",") ' Result: A,D,G
=CCROW(A$1:I$1,A3:I3,0,",") ' Result: A,D,G
=CCROW(A$1:I$1,A3:I3,0,", ") ' Result: A, D, G
IF you change CriteriaValue:
=CCROW(A$1:I$1,A3:I3,1) ' Result: BCEFHI
=CCROW(A$1:I$1,A4:I4,1) ' Result: ABDEGH
=CCROW(A$1:I$1,A5:I5,1) ' Result: ABCEFHI
Remarks
Lock ($) the row of SourceRowRange to keep it the same when the formula is copied down.
You can do it all in one formula if you like:
=CONCATENATE(IF($A1=0,'A',''),IF($B1=0,'B',''), ...)
Or put the intermediate strings in a separate row and then concatenate them (to save wear and tear on your fingers).
Are you going to this to many more columns, or just the ones you've mentioned? As long as the number of columns is relatively small, as in your picture, you can concatenate IF functions to achieve your result.
Here's what I did:
Using that formula will get you a result like the one you have:
Assuming also that you have the values in a worksheet like mine, just paste the formula =IF(B3=1,"",B$1)&IF(C3=1,"",C$1)&IF(D3=1,"",D$1)&IF(E3=1,"",E$1)&IF(F3=1,"",F$1)&IF(G3=1,"",G$1)&IF(H3=1,"",H$1)&IF(I3=1,"",I$1)&IF(J3=1,"",J$1)
in B7 and then drag to B8 and B9 to get the rest of the results.
Of course, if you are going to do this for many more columns, it's maybe best to use VBA.
Here, add this function to a module.
You can then call it directly via excel. Nice one.
Function conc(ref As Range, Optional Separator As String) As String
Dim Cell As Range
Dim Result As String
For Each Cell In ref
If Cell.Value = 0 Then
Result = Result & chr(64 + Cell.Column) & Separator
End If
Next Cell
If Separator <> "" Then conc = Left(Result, Len(Result) - 1) Else: conc = Result
End Function
The following array formula will do the job (enter it with Ctrl+Shift+Enter):
=CONCAT(IF($A1:$I1=0,UNICHAR(64+COLUMN($A1:$I1)),""))
For older Excel versions, use the legacy functions CONCATENATE() and CHAR() in place of these functions.
I have a problem I need help with involving Excel and VBA. I know next to nothing about Excel/VBA, and I need a coding solution to help me avoid performing the extremely tedious task of doing this manually (think hundreds of lines that need to be parsed where one row could become multiple rows in a new sheet). I've been searching the web for solutions, but I just keep getting confused by the answers (because I don't know anything about VB and using it to program a macro in Excel), so I figured I'd seek help for my specific problem.
Here is the rundown: I have a spreadsheet where I need to copy rows from a source sheet to a target sheet. The source sheet has 2 columns (A & B) that can be thought of as a key/value pair where col A contains the key and col B contains the value. The problem lies with the values in col B. The values can either be a single line of text or a numbered list of different texts
What I want to do is for each row in the source:
split the values in col B to get an array of each individual value (if the value is in the form of a numbered list)
create new rows in the target sheet by looping over the split array of values such that a new row will be created where:
new row col A = source row col A key and new row col B = current iteration index from the array of split values.
if no numbered list, just copy the source row into target sheet
Source
A B
key1 1. text1
2. text2
key2 1. text3
Target
A B
key1 text1
key1 text2
key2 text3
The numbered list in a cell will be multiple lines where each line of text is prepended by a decimal and a dot. This applies to single line cells as well.
(Update) Bear in mind that the values in either col A or B are not simple text values. These are full on sentences. So, I'm not sure a simple formula is going to work.
Split Multi Line
It is unclear which line separator occurs in the multi line cells. Choose one, vbLf worked for me.
Adjust the values in the constants section to fit your needs.
The Code
Sub SplitMultiLine()
Const cSheet1 As Variant = "Sheet1" ' Source Worksheet Name/Index
Const cFirstR As Integer = 1 ' Source First Row Number
Const cFirstC As Variant = "A" ' Source First Column Letter/Number
Const cLastC As Variant = "C" ' Source Last Column Letter/Number
Const cMulti As Integer = 2 ' Multi Column
Const cSplit As String = vbLf ' Split Char(vbLf, vbCrLf, vbCr)
Const cDot As String = "." ' Dot Char (Delimiter)
Const cSheet2 As Variant = "Sheet1" ' Target Worksheet Name/Index
Const cTarget As String = "E1" ' Target First Cell Address
Dim vntS As Variant ' Source Array
Dim vntSplit As Variant ' Split Array
Dim vntT As Variant ' Target Array
Dim lastR As Long ' Source Last Row
Dim i As Long ' Source Array Row Counter
Dim j As Integer ' Source/Target Array Column Counter
Dim k As Long ' Target Array Row Counter
Dim m As Integer ' Split Array Row Counter
' Paste Source Range into Source Array.
With Worksheets(cSheet1)
lastR = .Cells(.Rows.Count, cFirstC).End(xlUp).Row
vntS = .Range(.Cells(cFirstR, cFirstC), .Cells(lastR, cLastC))
End With
' Count the number of rows in target array.
For i = 1 To UBound(vntS)
k = k + UBound(Split(vntS(i, cMulti), cSplit)) + 1
Next
' Write from Source to Target Array.
ReDim vntT(1 To k, 1 To UBound(vntS, 2))
k = 0
For i = 1 To UBound(vntS)
k = k + 1
vntSplit = Split(vntS(i, cMulti), cSplit)
For m = 0 To UBound(vntSplit)
If InStr(vntSplit(m), cDot) > 0 Then
vntT(k, cMulti) = Trim(Right(vntSplit(m), Len(vntSplit(m)) _
- InStr(vntSplit(m), cDot)))
Else
vntT(k, cMulti) = vntSplit(m)
End If
For j = 1 To UBound(vntS, 2)
If j <> cMulti Then
vntT(k, j) = vntS(i, j)
End If
Next
k = k + 1
Next
k = k - 1
Next
' Paste Target Array into Target Range calculated from Target Frist Cell.
With Worksheets(cSheet2).Range(cTarget)
.Resize(UBound(vntT), UBound(vntT, 2)) = vntT
End With
End Sub
An Over-Commenting
Sub SplitMultiLineOverCommented()
Const cSheet1 As Variant = "Sheet1" ' Source Worksheet Name/Index
Const cFirstR As Integer = 1 ' Source First Row Number
Const cFirstC As Variant = "A" ' Source First Column Letter/Number
Const cLastC As Variant = "C" ' Source Last Column Letter/Number
Const cMulti As Integer = 2 ' Multi Column
Const cSplit As String = vbLf ' Split Char(vbLf, vbCrLf, vbCr)
Const cDot As String = "." ' Dot Char (Delimiter)
Const cSheet2 As Variant = "Sheet1" ' Target Worksheet Name/Index
Const cTarget As String = "E1" ' Target First Cell Address
Dim vntS As Variant ' Source Array
Dim vntSplit As Variant ' Split Array
Dim vntT As Variant ' Target Array
Dim lastR As Long ' Source Last Row
Dim i As Long ' Source Array Row Counter
Dim j As Integer ' Source/Target Array Column Counter
Dim k As Long ' Target Array Row Counter
Dim m As Integer ' Split Array Row Counter
' Paste Source Range into Source Array.
With Worksheets(cSheet1)
' The last row of data is usually calculated going from the bottom up,
' it is like selecting the last cell and pressing CTRL UP and returning
' =ROW() in Excel.
lastR = .Cells(.Rows.Count, cFirstC).End(xlUp).Row
' Paste a range into an array actually means copying it. The array
' created is a 1-based 2-dimensional array which has the same number
' of rows and columns as the Source Range.
vntS = .Range(.Cells(cFirstR, cFirstC), .Cells(lastR, cLastC))
End With
' Count the number of rows in Target Array.
' You refer to the last row of the array with UBound(vntS) which is short
' for UBound(vntS, 1) which reveals that it is referring to the first
' dimension (rows).
For i = 1 To UBound(vntS)
' We are splitting the string by cSplit which is the line
' separator (delimiter). When you enter something into a cell and
' hold left Alt and press ENTER, the vbLf character is set in place
' of the line separator. But the data may have been imported from
' another system that uses another line separator. When splitting the
' string, a 0-based array is 'created' and its UBound is the last
' row, but since it is 0-based we have to add 1.
k = k + UBound(Split(vntS(i, cMulti), cSplit)) + 1
Next
' Write from Source to Target Array.
' After we have calculated the number of rows, we have to resize the
' Target Array. To avoid confusion, I always use '1 To' to be certain that
' it is a 1-based array. Since the number columns of the Source Array and
' the Target Array is the same, we use the UBound of the Source Array to
' resize the second dimension of the Target Array - UBound(vntS, 2) where
' 2 is indicating the second dimension, columns.
ReDim vntT(1 To k, 1 To UBound(vntS, 2))
' We will use again k as the row counter since its value is no more
' needed. This is what I have many times forgotten, so maybe it is
' better to use a different variable.
k = 0
' Loop through the columns of Source Array.
For i = 1 To UBound(vntS)
' Increase the row of Target Array or e.g. align it for writing.
k = k + 1
' Split the string (lines) in the Multi Column into the 0-based
' Split Array.
vntSplit = Split(vntS(i, cMulti), cSplit)
' Loop through the values of the Split Array
For m = 0 To UBound(vntSplit)
' Check if value contains cDot. The Instr function returns 0 if
' a string has not been found, it's like =FIND(".",A1) in Excel,
' except that Excel would return an error if not found.
If InStr(vntSplit(m), cDot) > 0 Then
' If cDot was found then write the right part after cDot
' to the current row of column cMulti but trim the result
' (remove space before and after.
' It's like =TRIM(RIGHT(A1,LEN(A1)-FIND(".",A1))) in Excel.
vntT(k, cMulti) = Trim(Right(vntSplit(m), Len(vntSplit(m)) _
- InStr(vntSplit(m), cDot)))
Else
' If cDot was not found then just write the value to the
' current row.
vntT(k, cMulti) = vntSplit(m)
End If
' Loop through all columns.
For j = 1 To UBound(vntS, 2)
If j <> cMulti Then
' Write to other columns (Not cMulti)
vntT(k, j) = vntS(i, j)
End If
Next ' Next Source/Target Array Column
' Increase the current row of Target Array before going to next
' value in Split Array.
k = k + 1
Next ' Next Split Array Row
' Since we have increased the last current row but haven't written to
' it, we have to decrease one row because of the "k = k + 1" right below
' "For i = 1 To UBound(vntS)" which increases the row of Target Array
' for each next row in Source Array.
k = k - 1
Next ' Next Source Array Row
' Paste Target Array into Target Range calculated from Target Frist Cell.
' Like we pasted a range into an array, we can also paste an array into
' a range, but it has to be the same size as the array, so by using
' the Resize method we adjust the Target Range First Cell to the Target
' Range, using the last row and column of the Target Array. Again,
' remember UBound(vntT) is short for UBound(vntT, 1) (rows).
With Worksheets(cSheet2).Range(cTarget)
.Resize(UBound(vntT), UBound(vntT, 2)) = vntT
End With
End Sub
You can do this with two formulas.
I'm assuming your data is in Sheet1.
For the first columns, use the following formula:
=IF(ISBLANK(Sheet1!A2),A1,Sheet1!A2)
For the second one use:
=IFERROR(RIGHT(Sheet1!B2,LEN(Sheet1!B2)-FIND(". ",Sheet1!B2)-1),Sheet1!B2)
And populate down.
edit:
The first formula will look at the corresponding cell in Sheet1, column A. If it is blank, it will take the value of the cell above where the formula is. If it isn't blank, it will take the value of the cell in Sheet1, column A that it just checked.
The second formula looks for the string ". " in the cells in Sheet1 column B and removes it and everything to the left of it from the text. If the string in question (". ") is not found (meaning there is no numbering in that given cell) it would return an error, so the whole thing is wrapped in an IFERROR statement which returns the value of the cell in Sheet1 column B if it is triggered.
I have 2 text boxes in a excel (or csv file) as below:
text box 1 contains (#11111,#22222,#33333), text box 2 contains (#55555)
#11111,#22222,#33333 #55555
I want the text between , to be on 3 different rows and repeat the text in 2nd text box so that it looks like below:
#11111 #55555
#22222 #55555
#33333 #55555
I am new to VBA. I am reading about string functions but I can't come up with logic on how to do it.
Any help would be appreciated.
Hi #tim williams - Thanks for the advice. I did manage to write a short code which accomplishes the task but it overwrites the text if I have any in 2nd row and 3rd row.
Sub splitcells()
Dim txt As String
Dim txt2 As String
Dim i As Integer
Dim cell1 As Variant
txt = Range("a1", "A1").Value
cell1 = Split(txt, ",")
For i = 0 To UBound(cell1)
Cells(i + 1, 1).Value = cell1(i)
Next i
txt2 = Range("b1", "b1")
For i = 1 To UBound(cell1)
Cells(i + 1, 2).Value = txt2
Next i
End Sub
Any advice on how to push the data on row 2 downwards .....
I do not know how to give you a hint that would help you adjust your macro so I have coded what I think you are after.
You talk about overwriting data in the 2nd or 3rd row so I assume you have several rows containing data in this format. I have therefore converted your code into a loop that works down column A until it finds a blank row.
I avoid overwriting data below the current row by inserting rows as necessary.
I have changed your code in ways that I believe makes the code more maintainable. I have explained my reasons for
these changes.
I have not explained the new statements I have used. It is generally easy to look up a statement once you know it exists but do ask questions if anything is unclear.
I hope this helps.
Option Explicit
Sub splitcells()
' * With VBA, Integer declares a 16-bit value while Long declares a 32-bit
' value. 16-bit values require special processing and are slower. So
' Long is preferred.
' * I do not like variable names such as i. It does not really matter with
' a tiny macro but with a larger macro it does. It does not matter now
' but it matters when you return to this macro in 6 or 12 months to amend
' it. You want to be able to look at variables and immediately know what
' they are. I have named variables according to my system. I am not
' asking you to like my system but to have a system. I can return to
' macros I wrote years ago and immediately recognise all the variables.
Dim InxSplit As Long
' Dim i As Integer
' * Split returns a string array. A Variant can be hold a string array but
' access is slower. Variants can be very useful but only use then when
' you need the flexibility they offer.
Dim SplitCell() As String
' Dim cell1 As Variant
Dim RowCrnt As Long
' * "Range" operates on the active worksheet. You are relying on the correct
' worksheet being active when the macro is called. Also, when you return
' to the macro in 6 or 12 months will you remember which worksheet is
' supposed to be active. ".Range" operates on the worksheet specified in
' the With statement. It doe not matter which worksheet is active and it
' is absolutely clear which worksheet is the target of this code.
With Worksheets("Sheet1")
RowCrnt = 1 ' The first row containing data.
Do While True
' * I use .Cells(row, column) rather than .Range because it is more
' convenient when you need to change the row and/or column numbers.
' * Note the column value can be a number or a column identifier.
' A = 1, B=2, Z=26, AA = 27, etc. I am not doing arithmetic with
' the columns so I have used "A" and "B" which I find more
' meaningful than 1 and 2.
If .Cells(RowCrnt, "A").Value = "" Then
Exit Do
End If
SplitCell = Split(.Cells(RowCrnt, "A").Value, ",")
If UBound(SplitCell) > 0 Then
' The cell contained a comma so this row is to be spread across
' two or more rows.
' Update the current row
.Cells(RowCrnt, "A").Value = SplitCell(0)
' For each subsequent element of the split value, insert a row
' and place the appropriate values within it.
For InxSplit = 1 To UBound(SplitCell)
RowCrnt = RowCrnt + 1
' Push the rest of the worksheet down
.Rows(RowCrnt).EntireRow.Insert
' Select the appropriate part of the original cell for this row
.Cells(RowCrnt, "A").Value = SplitCell(InxSplit)
' Copy the value from column B from the previous row
.Cells(RowCrnt, "B").Value = .Cells(RowCrnt - 1, "B").Value
Next
End If
RowCrnt = RowCrnt + 1
Loop
End With
End Sub
I have a sheet1 that has names in column A and I have names in sheet 2 column A. The names are mostly the same, besides a comma or period on sheet 2 and not on sheet 1. I need to match some of the text and take sheet 1 column B and paste to sheet 2 column B.
example:
Sheet 1
A B
Doug, Inc. $12.03
For it all, LLC $4452.03
Go for it, Inc. $235.60
Sheet 2
A B
Doug, Inc - Joe
For it all - Mike
Go for it Inc - Tom
I have code that will match and paste only if the names match exact, before the dash "-".
I need help getting it to match just some of the text, not caring about the comma's or periods.
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
Set rng1 = ws2.Range(ws2.[a1], ws2.Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 1)
.FormulaR1C1 = "=IF(RC[-1]<>"""",IF(NOT(ISERROR(MATCH(LEFT(RC[-1],FIND("" - "",RC[-1])-1),'" & ws1.Name & "'!C[-1],0))),INDEX('" & ws1.Name & "'!C,MATCH(LEFT(RC[-1],FIND("" - "",RC[-1])-1),'" & ws1.Name & "'!C[-1],0)),""""),"""")"
.Value = .Value
End With
I have refactored your formula
It will simplify your code if you use a Named Range for your sheet 1 data. Here I've used the name Data
I've used VLookup rather than Index(Match( to further shorthen the formula
The double Substitute's replace , and . in the lookup range
The formula must be an Array formula for the Substitues to work.
Because of the Substitute the returned value is a string. I've wraqpped the function in a Value to convert back to a number, Remove this if not required.
The lookup value is prepared before the call to VLookup, stripping off the - ... if present
'
.FormulaArray = "=VALUE(VLOOKUP(" & _
"LEFT(RC[-1],IFERROR(FIND("" - "",RC[-1])-1,LEN(RC[-1])))," & _
"SUBSTITUTE(SUBSTITUTE(Data,"","",""""),""."",""""),2,0))"
There is one aspect of your sample data that I am unsure about
For it all - Mike will become For it all.
- This won't match For it all, LLC (which becomes For it all LLC)
Go for it Inc - Tom will become Go for it Inc.
- This will match Go for it, Inc. (which becomes Go for it Inc)
Doug, Inc - Joe will become Doug, Inc.
- This won't match Doug, Inc. (which becomes Doug Inc`)
If you want to ignore , and . in both sheets, use
.FormulaArray = "=VALUE(VLOOKUP(" & _
"SUBSTITUTE(SUBSTITUTE(LEFT(RC[-1],IFERROR(FIND("" - "",RC[-1])-1,LEN(RC[-1]))),"","",""""),""."","""")," & _
"SUBSTITUTE(SUBSTITUTE(Data,"","",""""),""."",""""),2,0))"
I am not sure I understand what you are trying to achieve. I do not understand your code which just seems to clear column B of sheet 2. I do not understand why you are using a macro to set formula.
The code below does what I think you are trying to do. If not, I hope my code gives you enough ideas so you can create the code you seek.
I am guessing you are not that familiar with Excel Basic. Sorry if the following insults your knowledge. I assume you would rather be insulted than confused.
Sub Test2()
' This is revised coding. I had not read the question carefully enough
' so my original code did not do what was required.
Dim Pos2 As Integer ' The 1s and 2s in variable names
Dim RowCrnt As Integer ' identify the variable as being for Sheet1
Dim RowMax As Integer ' or Sheet2. The same row variables are
Dim S1ColAB() As Variant ' used for both sheets.
Dim S2ColAB() As Variant
Dim Value1 As String
Dim Value2 As String
With Sheets("Sheet2")
' I generally use Find instead of End(xlUp) for reasons I no longer
' remember. This searches column A (Columns("A")) for anything ("*")
' starting from cell A1 (Range("A1")) and moving backwards
' (xlPrevious) until it finds a value.
RowMax = .Columns("A").Find("*", .Range("A1"), xlFormulas, , _
xlByRows, xlPrevious).Row
' Range(Cells(A,B),Cells(C,D)) defines a rectangle of cells with Row=A,
' Col=B as top left and Row=C, Col=D as bottom right.
' The following statement loads the contents of a block of cells to a
' variant array. Another question has led to a discussion about the value
' of using variant arrays in this way. I have found that moving values
' from one sheet to another can be very slow so I believe it is useful in
' this situation.
S2ColAB = .Range(.Cells(1, 1), .Cells(RowMax, 2)).Value
' Warning about moving values from a cell into a string or variant variable
' and then from the variable into another cell.
' =========================================================================
' When moving the value from the variable to the cell, Excel will
' misinterpret the value if it can.
'
' For example, if the value is 13/1/11 (13 January 2011 here in England)
' this value will be correctly transferred into the new cell. But if the
' value is 4/1/11 (4 January 2011), Excel will recognise this as a valid
' American date and set the new cell to 1 April 2011. The damage that bug
' caused by corrupting a third my dates! I had tested my code towards the
' end of a month and it worked perfectly until the next month.
'
' In this example, string $12.03 becomes currency 12.03 and displays
' here as £12.03.
End With
With Sheets("Sheet1")
' Load the matching cells from sheet 1
S1ColAB = .Range(.Cells(1, 1), .Cells(RowMax, 2)).Value
End With
With Sheets("Sheet2")
For RowCrnt = 1 To RowMax
' I move the Column A values for matching row from the arrays to string
' variables so I can amend their values without losing the original
' values. This was essential with my original code and I have not
' changed it since I think it makes the code easier to understand and
' probably marginally faster.
Value1 = S1ColAB(RowCrnt, 1)
Value2 = S2ColAB(RowCrnt, 1)
' The following code removes anything following a hyphen from Value 2.
' It then removes all commas and dots from both Value1 and Value2. If
' the final values are the same, it moves the Column B of Sheet1 to
' Sheet2.
Pos2 = InStr(1, Value2, "-")
If Pos2 <> 0 Then
' Pos2 is not zero so extract the portion of Value2 up to the "-"
' and then trim trailing spaces.
Value2 = RTrim(Mid(Value2, 1, Pos2 - 1))
End If
' Replace all commas with nothing.
Value1 = Replace(Value1, ",", "")
' Replace all dots with nothing.
Value1 = Replace(Value1, ".", "")
' Merge the two replaces into a single statement.
Value2 = Replace(Replace(Value2, ",", ""), ".", "")
If Value1 = Value2 Then
' If the modified values are equal, copy the Column 2 (B) from
' Sheet1 to Sheet2.
.Cells(RowCrnt, 2).Value = S1ColAB(RowCrnt, 2)
End If
Next
End With
End Sub
Hope this helps. Come back if I have not explained myself adequately.