In Excel,
I have a bunch of information on Sheet1/column A and would like to search specific text (starting from the word N1*PE* up to the 9 numbers before "~N"),
And then compare (Sheet1/Column A) from the correct list (Sheet2/Column A) & then paste it on a separate worksheet (Sheet3/Column A).
Here's an example:
In Sheet 1 Column A : (I have WRONG information below)
EDI DEPARTMENT*TE*2658018518~N1*PE* ELMHUR
ST CENTER*XX*564824568~N4*GREAT NECK*NY*11023
N1*PE COOPER XX*333333333~N4*NEW YORK*NY*10077-5281~REF*TJ*133988001~LX*7111~
As you noticed, the word ELMHURST is broken.
What I would like to accomplish is to replace the wrong text (on Sheet1/Column A) based from the sample list (On Sheet2/Column A) and paste it on Sheet3/Column A --> using the same format .
Here's the (CORRECT) Sample Information List (Sheet2/Column A):
N1*PE ELMHURST CENTER XX*454545457
N1*PE COOPER XX*123457777
So, in the result should be:
In Sheet3/Column A...
EDI DEPARTMENT*TE*2658018518~N1*PE* ELMHUR
ST CENTER*XX*454545457~N4*GREAT NECK*NY*11023
N1*PE COOPER XX*123457777~N4*NEW YORK*NY*10077-5281~REF*TJ*133988001~LX*7111~
The Code below is incomplete. As it can only copy and paste on Sheet2 Column A.
Option Explicit
Public Sub Transfer()
Dim lngRow As Long, lngWriteRow As Long, strTemp As String
Dim shtRaw As Worksheet, shtNew As Worksheet
' Initialize
lngWriteRow = 1 'The row we're writing to
Set shtRaw = Sheets("Sheet1") 'The raw data worksheet
Set shtNew = Sheets("Sheet2") 'The sheet with the concatenated text
For lngRow = 1 To shtRaw.UsedRange.Rows.Count
If InStr(1, shtRaw.Cells(lngRow, 1), "N1*PE*", vbTextCompare) > 0 Then
' Grab the end of this cell's text starting at N1*PE*
strTemp = Mid(shtRaw.Cells(lngRow, 1), InStr(1, shtRaw.Cells
(lngRow, 1), "N1*PE*", vbTextCompare))
' Add the start of the next cell's text, up to the ~N
strTemp = strTemp & Left(shtRaw.Cells(lngRow + 1, 1), InStr(1, shtRaw.Cells(lngRow + 1, 1), "~N", vbTextCompare))
' Write the concatenated string to the other worksheet
shtNew.Cells(lngWriteRow, 1) = strTemp
' NEED TO DO SOMETHING HERE... COMPARE THE TEXT FROM THE LIST AND PASTE IT ON SHEET 3 COLUMN A
' Move down one row for the next time we write to the other sheet
lngWriteRow = lngWriteRow + 1
End If
Next lngRow
'Sort the NPIs
Sheets("Sheet2").Select
Range("A:A").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes
' Clean up memory
Set shtRaw = Nothing
Set shtNew = Nothing
End Sub
Many Thanks in advance...
The below may work. Your replacement values seem to have arbitrarily missing * and space characters compared to the originals (ie PE* ELM.. vs PEELM..). That makes it hard to be certain how long each repaired row should be on Sheet3. I made an arbitrary decision it should be the same length as the first of the two cells I'm concatenating for the purpose of this demo, but that method might need some refinement after many rows have been processed. If you need the start characters to match existing you need to do something similar to what I did here and and find the positions of the following row start characters and divide the NewCombinedString accordingly.
Sub FixSheet1ColumnA()
Dim i As Integer
i = 1
Do While Sheet1.Range("A" & i) <> ""
'Combined adjoining rows to account for values which overlap between rows
Dim Cell1Value As String
Dim Cell2Value As String
Dim CombinedString As String
'The upper of the rows should come from whatever has been processed onto
'Sheet3 except for the very first row which has to come from Sheet1
If i = 1 Then Cell1Value = Sheet1.Range("A" & i) Else Cell1Value = Sheet3.Range("A" & i)
Cell2Value = Sheet1.Range("A" & i + 1)
CombinedString = Cell1Value & Cell2Value
Dim SearchString As String
'Strip the * and space characters out of the string to search it as there
'seem to be random extras of these in Sheet1 column A
SearchString = Replace(Replace(CombinedString, " ", ""), "*", "")
'Cycle through Sheet2 column A to see if there are any matches for the
'first n-9 digits of each value there, also removing * and space characters
'for consistency
Dim j As Integer
j = 1
Do While Sheet2.Range("A" & j) <> ""
Dim ReplacementString As String
ReplacementString = Sheet2.Range("A" & j)
Dim FindString As String
FindString = Replace(Replace(ReplacementString, " ", ""), "*", "")
'determine if the first n-9 characters of the given Sheet2 value are found
Dim SubStringPosition As Integer
SubStringPosition = InStr(1, SearchString, Left(FindString, Len(FindString) - 9))
If SubStringPosition <> 0 Then
'Find the tilde that immediately precedes the string to be replaced
Dim FirstTildePosition As Integer
FirstTildePosition = InStr(SubStringPosition, CombinedString, "~")
'Find the tilde that follows it
Dim SecondTildePosition As Integer
SecondTildePosition = InStr(FirstTildePosition + 1, CombinedString, "~")
Dim NewCombinedString As String
NewCombinedString = Left(CombinedString, FirstTildePosition) _
+ ReplacementString _
+ Right(CombinedString, Len(CombinedString) - SecondTildePosition + 1)
Exit Do
End If
j = j + 1
Loop
'Populate the first part of potentially fixed CombinedString into Sheet3
If i = 1 Then Sheet3.Range("A" & i) = Left(NewCombinedString, Len(Cell1Value))
Sheet3.Range("A" & i + 1) = Right(NewCombinedString, Len(NewCombinedString) - Len(Cell1Value))
i = i + 1
Loop
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.