Need help with a "If" "Else" VB code

P

pgarcia

Hello all,
Newbe here,
Could someone help me with the following code. If a number is not there,
then go on to the next step. But I'm misisng somthing.
Thanks

Sub R_2_R()

Application.ScreenUpdating = False

With ActiveSheet

Cells.Select
Cells.EntireColumn.AutoFit
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:="rq by ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:="rcn ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("C:C").Select
Selection.Style = "Currency"
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:="dpd ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("D:D").Select
Selection.TextToColumns Destination:=Range("D:d"),
DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 3), TrailingMinusNumbers:=True
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:="bk ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=".pdf", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select

Dim RngToFilter As Range

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=031"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False

Else

Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="031", Replacement:="031 Check", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=032"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False

Else

Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="032", Replacement:="032 Check", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=033"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="033", Replacement:="033 Check", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=614"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="614", Replacement:="614 Check", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=800 wire"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="800 wire", Replacement:="800 Wire",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=900 ach"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="900 ach", Replacement:="900 ACH",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=900 cc"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="900 cc", Replacement:="900 Credit",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=631"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="631", Replacement:="631 Wire", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=710"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="710", Replacement:="710 Netting",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=711"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="711", Replacement:="711 Netting",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=712"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="712", Replacement:="712 Netting",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=713"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="713", Replacement:="713 Netting",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=731"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="731", Replacement:="731 Wire", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=914"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="914", Replacement:="914 Check", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=961"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="7961", Replacement:="961 Wire", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

Set RngToFilter = .Range("A:E")
RngToFilter.AutoFilter Field:=5, Criteria1:="=933"
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
.AutoFilterMode = False
Else
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Replace What:="933", Replacement:="933 Credit Card",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

Range("A1").Select

.AutoFilterMode = False

End With
End Sub
 
J

Joel

See if this code is better


Sub R_2_R()
OldData = Array("031", "032", "033", "614", _
"800 wire", "900 ach", "900 cc", "631", _
"710", "711", "712", "713", _
"714", "914", "961", "933")
NewData = Array("031 Check", "032 Check", "033 Check", "614 Check", _
"800 Wire", "900 ACH", "900 Credit", "631 Wire", _
"710 Netting", "711 Netting", "712 Netting", "712
Netting", _
"914 Check", "961 Wire", "933 Credit Card")


Application.ScreenUpdating = False

With ActiveSheet

Cells.EntireColumn.AutoFit
Set DataRange = .Range(Range("A2"), .Range("A2").End(xlDown))
DataRange.Replace _
what:="rq by ", _
Replacement:="", _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False

Set DataRange = .Range(.Range("B2"), .Range("B2").End(xlDown))
DataRange.Replace _
what:="rcn ", _
Replacement:="", _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Columns("C:C").Style = "Currency"

Set DataRange = .Range(.Range("D2"), .Range("D2").End(xlDown))
DataRange.Replace _
what:="dpd ", _
Replacement:="", _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False

Columns("D:D").TextToColumns _
Destination:=Range("D:d"), _
DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 3), _
TrailingMinusNumbers:=True

Set DataRange = .Range(.Range("E2"), .Range("E2").End(xlDown))
DataRange.Replace _
what:="bk ", _
Replacement:="", _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False

DataRange.Replace _
what:=".pdf", _
Replacement:="", _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False

Range("A1").Select

Dim RngToFilter As Range

For i = LBound(OldData) To UBound(OldData)
Oldstr = OldData(i)
NewStr = NewData(i)

Set RngToFilter = .Range("A:E")
Set c = .Columns("E").Find(what:=Oldstr, LookIn:=xlValues, _
lookat:=xlWhole)
If Not c Is Nothing Then
RngToFilter.AutoFilter Field:=5, Criteria1:="=" & Oldstr
With .AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count =
1 Then
.AutoFilterMode = False

Else

Set DataRange =
ActiveSheet.Cells.SpecialCells(xlCellTypeVisible)

DataRange.Replace _
what:=Oldstr, _
Replacement:=NewStr, _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
End If
End With

.AutoFilterMode = False
End If
Next i
End With
End Sub
 
P

pgarcia

Thanks, I get the following error:
Run-time error '9': Subscript our of range

Then the yellow stops at the following line:
NewStr = NewData(i)
 
J

Joel

fix these lines. I had two 712's and missed 714 in the NewData array.

from
OldData = Array("031", "032", "033", "614", _
"800 wire", "900 ach", "900 cc", "631", _
"710", "711", "712", "713", _
"714", "914", "961", "933")
NewData = Array("031 Check", "032 Check", "033 Check", "614 Check", _
"800 Wire", "900 ACH", "900 Credit", "631 Wire", _
"710 Netting", "711 Netting", "712 Netting", "712
Netting", _
"914 Check", "961 Wire", "933 Credit Card")


to
OldData = Array("031", "032", "033", "614", _
"800 wire", "900 ach", "900 cc", "631", _
"710", "711", "712", "713", _
"714", "914", "961", "933")
NewData = Array("031 Check", "032 Check", "033 Check", "614 Check", _
"800 Wire", "900 ACH", "900 Credit", "631 Wire", _
"710 Netting", "711 Netting", "712 Netting", "713
Netting", _
"714 Netting","914 Check", "961 Wire", "933 Credit Card")
 
P

pgarcia

That was great, thanks.

Joel said:
fix these lines. I had two 712's and missed 714 in the NewData array.

from
OldData = Array("031", "032", "033", "614", _
"800 wire", "900 ach", "900 cc", "631", _
"710", "711", "712", "713", _
"714", "914", "961", "933")
NewData = Array("031 Check", "032 Check", "033 Check", "614 Check", _
"800 Wire", "900 ACH", "900 Credit", "631 Wire", _
"710 Netting", "711 Netting", "712 Netting", "712
Netting", _
"914 Check", "961 Wire", "933 Credit Card")


to
OldData = Array("031", "032", "033", "614", _
"800 wire", "900 ach", "900 cc", "631", _
"710", "711", "712", "713", _
"714", "914", "961", "933")
NewData = Array("031 Check", "032 Check", "033 Check", "614 Check", _
"800 Wire", "900 ACH", "900 Credit", "631 Wire", _
"710 Netting", "711 Netting", "712 Netting", "713
Netting", _
"714 Netting","914 Check", "961 Wire", "933 Credit Card")
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

find and replace multiple values in one statement 3
Help with a loop please. 10
Macro to select columns and replace data 6
Find and Replace Help 3
Can I improve processing speed of macro 4
VBA to Fix Dates 5
code takes to long 8
Slow Macro 7

Top