PDA

View Full Version : Replacing Text evenly from 1 sheet to another sheet



Rashidz
01-19-2018, 04:57 AM
Hi,

I need help for creating a macro that can replace text on Sheet 1 to the text on Sheet 2. (see attachment file) 21398


Eg.

In sheet 1

Part 1, it consists of
Data 10
Data 15
Data 35
Data 20
Data 30
Data 10

Part 2, it consists of
Data 35
Data 50
Data 10
Data 15
Data 30

Part 3, it consists of
Data 30
Data 32
Data 10
Data 15
Data 10



In sheet 2

It consists of
10 LADY
10 CHILDREN
10 MAN
10 HAZMAT

30 BROADER
30 INSPIRATIONAL
30 STORY MATTER

How can I replace all DATA 10 to 10 LADY, 10 CHILDREN, 10 MAN and 10 HAZMAT rotate evenly over all the PART of sheet 1
and also replace DATA 30 with 30 BROADER, 30 INSPIRATIONAL and 30 STORY MATTER rotate evenly over all the PART of sheet 1.

P.S. There are more that 10 parts, I'm giving example for 3 parts only.

I tried this formula but dont really work my cases.

Sub Multi_FindReplace()

Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long

fndList = Array("DATA 10")
rplcList = Array("10 LADY", "10 CHILDREN", "10 MAN", "10 HAZMAT")


For x = LBound(fndList) To UBound(fndList)

For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht

Next x

End Sub



Please help.

Thanks

offthelip
01-19-2018, 08:25 AM
I can't understand your requirement at all, please can you upload a workbook which shows how your data is arranged and also how you want the data to look after the macor has been run. Then we might be able tohelp.

jolivanes
01-19-2018, 03:58 PM
Enlighten us. What are parts?

Paul_Hossler
01-20-2018, 12:08 PM
I sort of think I might just maybe understand

I didn't know if you wanted the replacements to start over each time there's a new PART, so this version doesn't start over when PART changes

So 6, 13, 15 and 23 are replaced with the first, second, third, and then the first again since there are only 3 "DATA 30" replacements

It can be added

21410





Option Explicit
Option Base 1

Dim rOriginal As Range, rReplace As Range
Sub Rotate()
Dim rArea As Range, rStart As Range
Dim vBlock() As Variant
Dim n As Long

Application.ScreenUpdating = False

'note space in sheet name
Set rOriginal = Worksheets("Sheet 1").Range("A:A").SpecialCells(xlCellTypeConstants)
Set rReplace = Worksheets("Sheet 2").Range("A:F").SpecialCells(xlCellTypeConstants)

For Each rArea In rReplace.Areas
'make even single cell areas into array starting at 1
If rArea.Cells.Count = 1 Then
vBlock = Array(rArea.Value)
ReDim Preserve vBlock(1 To 1)
Else
vBlock = Application.WorksheetFunction.Transpose(rArea.Value)
End If

Call ReplaceBlock(vBlock())
Next

Application.ScreenUpdating = True
End Sub


Private Sub ReplaceBlock(A() As Variant)
Dim C As Range
Dim n As Long
Dim firstAddress As String
Dim sPrefix As String

sPrefix = Left(A(1), 2)

n = 1

With rOriginal
Set C = .Find("DATA " & sPrefix, LookIn:=xlValues)

If Not C Is Nothing Then
firstAddress = C.Address
Do
C.Value = A(n)
n = n + 1
If n > UBound(A) Then n = 1
Set C = .FindNext(C)
Loop While Not C Is Nothing
End If
End With
End Sub

Rashidz
02-08-2018, 05:13 AM
Thank you Paul. You are great. :thumb This is exactly what I wanted.

Another question. Currently I have DATA 10, DATA 15, DATA 20, DATA 30, DATA 32 and DATA 35. What if I have an additional DATA 60. Where do i change the formula? And also your formula link to the numbers matching the DATA no. What if the lookup data doesnt have a number attach to it.

Paul_Hossler
02-08-2018, 07:51 PM
1. I added some DATA 60 to Sheet2. As long as they're in a separate group and you adjust these lines



Set rOriginal = Worksheets("Sheet 1").Range("A:A").SpecialCells(xlCellTypeConstants)
Set rReplace = Worksheets("Sheet 2").Range("A:F").SpecialCells(xlCellTypeConstants)



2. It's the number on DATAxx that is used to link the other data

Rashidz
02-09-2018, 12:32 AM
1. I added some DATA 60 to Sheet2. As long as they're in a separate group and you adjust these lines



Set rOriginal = Worksheets("Sheet 1").Range("A:A").SpecialCells(xlCellTypeConstants)
Set rReplace = Worksheets("Sheet 2").Range("A:F").SpecialCells(xlCellTypeConstants)



2. It's the number on DATAxx that is used to link the other data

2. No, DATAxx is not used to link other data.


Thanks for your help though but I've achieved what I wanted. Here are the example that I need and maybe I would share it here, DataXX not link to other data.

Sub replaceData()

Dim Ary10 As Variant
Dim Cnt As Long
Dim Qty As Long
Dim Fnd As Range
Dim i As Long

Ary10 = Array("LADY", "CHILDREN", "MAN", "HAZMAT")
Qty = WorksheetFunction.CountIf(Columns(1), "DATA 10")
For Cnt = 1 To Qty
Set Fnd = Columns(1).Find("DATA 10", , , xlWhole, , , False, , False)
If Not Fnd Is Nothing Then
Fnd.Value = Ary10(i)
i = i + 1
If i > UBound(Ary10) Then i = 0
End If
Next Cnt

End Sub

Paul_Hossler
02-09-2018, 09:12 AM
1. Glad you have something that works

2. Although that does seem a little different from first request


How can I replace all DATA 10 to 10 LADY, 10 CHILDREN, 10 MAN and 10 HAZMAT rotate evenly over all the PART of sheet 1
and also replace DATA 30 with 30 BROADER, 30 INSPIRATIONAL and 30 STORY MATTER rotate evenly over all the PART of sheet 1.

snb
02-09-2018, 10:38 AM
I'd use:


Sub M_snb()
sn = Array("LADY", "CHILDREN", "MAN", "HAZMAT")

for j=0 to ubound(sn)
columns(1).find("DATA 10").value=sn(j)
Next
End Sub