decadence
Well-known Member
- Joined
- Oct 9, 2015
- Messages
- 525
- Office Version
- 365
- 2016
- 2013
- 2010
- 2007
- Platform
- Windows
Hi, I am trying to step through a varied range to get the first letter of that cell and put that letter in another varied range cell on the same row then go to the next cell in the 1st range.
I know the 2nd range is the issue but not sure how to fix it, Can some one help please. Code Below...
Example:
From
[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]Ref[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Foot[/TD]
[/TR]
[TR]
[TD]C123[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]986[/TD]
[/TR]
[TR]
[TD]K1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]R077[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]77[/TD]
[/TR]
</tbody>[/TABLE]
To
[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]Ref[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Foot[/TD]
[/TR]
[TR]
[TD]C123[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]C987[/TD]
[/TR]
[TR]
[TD]K1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]K11[/TD]
[/TR]
[TR]
[TD]R077[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]R077[/TD]
[/TR]
</tbody>[/TABLE]
I know the 2nd range is the issue but not sure how to fix it, Can some one help please. Code Below...
Code:
Option Explicit
Option Compare Text
Dim Rng1 As Range, Rng2 As Range, xVal1 As Range, xVal2 As Range, s As String, sStr As String, Fnd1 As Range, Fnd2 As Range, Rng As Range
Sub MacroTest()
'
Set Rng1 = RngRef
Set Rng2 = RngFoot
If Not Rng1 Is Nothing Then
If Not Rng2 Is Nothing Then
For Each xVal1 In Rng
xStr = GetRef(xVal1.Value)
If xStr = "C" Or xStr = "R" Then
For Each xVal2 In Rng2
If xStr = "C" Then
If UCase(Left(Rng1(xVal2.Value), 1)) <> "0" Then
xVal2.Value = xStr & "0" & xVal2.Value
Else
xVal2.Value = xStr & xVal2.Value
End If
ElseIf xStr = "R" Then
If UCase(Left(xVal2.Value, 1)) <> "0" Then
xVal2.Value = xStr & "0" & xVal2.Value
Else
xVal2.Value = xStr & xVal2.Value
End If
End If
Next xVal2
Else
End If
Next xVal1
Else
MsgBox "Ref Column Not Found"
End If
Else
MsgBox "Foot Column not Found"
End If
End Sub
Function GetRef(xStr As String) As String
Dim i As Long, sStr As String, s As String
sStr = vbNullString
For i = 1 To Len(xStr)
s = Mid(xStr, i, 1)
If Asc(LCase(s)) >= 97 And Asc(LCase(s)) <= 122 Then
sStr = sStr + s
End If
Next
GetRef = sStr
End Function
Function RngRef() As Range
Set Fnd1 = ActiveSheet.Columns.Find(What:="Ref", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not Fnd1 Is Nothing Then
Set RngRef = Range(Fnd1.Offset(1), Cells(Rows.Count, Fnd1.Column).End(xlUp))
End If
End Function
Function RngFoot() As Range
Set Fnd2 = ActiveSheet.Columns.Find(What:="Foot", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not Fnd2 Is Nothing Then
Set RngFoot = Range(Fnd2.Offset(1), Cells(Rows.Count, Fnd2.Column).End(xlUp))
End If
End Function
Example:
From
[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]Ref[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Foot[/TD]
[/TR]
[TR]
[TD]C123[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]986[/TD]
[/TR]
[TR]
[TD]K1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]R077[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]77[/TD]
[/TR]
</tbody>[/TABLE]
To
[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]Ref[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Foot[/TD]
[/TR]
[TR]
[TD]C123[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]C987[/TD]
[/TR]
[TR]
[TD]K1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]K11[/TD]
[/TR]
[TR]
[TD]R077[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]R077[/TD]
[/TR]
</tbody>[/TABLE]
Last edited: