PDA

View Full Version : Problem in Executing the Code



Sarfaraz
01-05-2017, 10:30 PM
Hi,
I actually merged a new code within my existing code. Due to which I think it is not working otherwise separately all codes were working fine. Can somebody help me


Sub Refresh()
'
' Macro1 Macro
'
'
Dim Lastrow As Long
Dim pos As Long
Dim i As Long

Application.ScreenUpdating = False
Sheets("Assigned load").Select
With ActiveSheet

Lastrow = .Cells(.Rows.Count, "I").End(xlUp).Row
For i = Lastrow To 2 Step -1

pos = InStr(.Cells(i, "I").Value, "+")
If pos > 0 Then .Cells(i, "I").Value = Left$(.Cells(i, "I").Value, pos - 1)
Next i


Sheets("Assigned load").Select
ActiveWindow.SmallScroll ToRight:=3
Columns("S:S").Select
Cells.Replace "43410", "ABC"
Cells.Replace "41235", "DEF"
Cells.Replace "43404", "GHI"
Cells.Replace "43405", "JKL"
Cells.Replace "43407", "MNO"
Cells.Replace "43408", "PQR"
"

Option Explicit
Sub DeletePK0000()
Columns("q:q").Select
Dim r As Range, c As Range

If Not TypeOf Selection Is Range Then Exit Sub

Set r = Intersect(Selection, Selection.Parent.UsedRange)

On Error Resume Next
Set r = r.SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo 0
If r Is Nothing Then Exit Sub

For Each c In r.Cells
If c.Value Like "PK#### *" Then c.Value = Right(c.Value, Len(c.Value) - 7)
Next
End Sub


Sheets("Pivot").Select
Sheets("Pivot").Name = "Pivot"
ActiveSheet.PivotTables("PivotTable1").PivotSelect "'Customer Name'[All]", _
xlLabelOnly, True
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
Range("D3").Select
End Sub

Bob Phillips
01-06-2017, 03:06 AM
Some details perhaps? Such as the data, what it is trying to do, and where it fails. Some people here are good, but even they need some direction.

offthelip
01-07-2017, 07:14 AM
just guess but should:

Left$(.Cells(i, "I").Value, pos - 1)

really be
Left(.Cells(i, "I").Value, pos - 1)

Paul_Hossler
01-07-2017, 07:33 AM
If you delete the lines marked ------------------- and add the line marked ++++++++++++++ it will at least compile

Doing what you want it to do is a different story


I see you've include the Selection code from your other question. Better to replace it with addresses if you're trying to integrate two macros





Option Explicit
Sub Refresh()
Dim Lastrow As Long
Dim pos As Long
Dim i As Long
Application.ScreenUpdating = False

Sheets("Assigned load").Select
With ActiveSheet

Lastrow = .Cells(.Rows.Count, "I").End(xlUp).Row
For i = Lastrow To 2 Step -1

pos = InStr(.Cells(i, "I").Value, "+")
If pos > 0 Then .Cells(i, "I").Value = Left$(.Cells(i, "I").Value, pos - 1)
Next I

End With '+++++++++++++++++++++++++++++++++++++++++++++++++++++++


Sheets("Assigned load").Select
ActiveWindow.SmallScroll ToRight:=3
Columns("S:S").Select
Cells.Replace "43410", "ABC"
Cells.Replace "41235", "DEF"
Cells.Replace "43404", "GHI"
Cells.Replace "43405", "JKL"
Cells.Replace "43407", "MNO"
Cells.Replace "43408", "PQR"
' " --------------------------------------------
'Option Explicit------------------------------
'Sub DeletePK0000()------------------------------
Columns("q:q").Select
Dim r As Range, c As Range

If Not TypeOf Selection Is Range Then Exit Sub

Set r = Intersect(Selection, Selection.Parent.UsedRange)

On Error Resume Next
Set r = r.SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo 0
If r Is Nothing Then Exit Sub

For Each c In r.Cells
If c.Value Like "PK#### *" Then c.Value = Right(c.Value, Len(c.Value) - 7)
Next
'End Sub------------------------------------------------------
Sheets("Pivot").Select
Sheets("Pivot").Name = "Pivot"
ActiveSheet.PivotTables("PivotTable1").PivotSelect "'Customer Name'[All]", _
xlLabelOnly, True
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
Range("D3").Select
End Sub

Paul_Hossler
01-07-2017, 07:41 AM
This is an UNTESTED better organized version of the macro that MIGHT be closer





Option Explicit
Sub Refresh()
Dim Lastrow As Long
Dim pos As Long
Dim i As Long
Dim r As Range, c As Range
Application.ScreenUpdating = False

With Worksheets("Assigned load")
Lastrow = .Cells(.Rows.Count, "I").End(xlUp).Row

For i = Lastrow To 2 Step -1
pos = InStr(.Cells(i, "I").Value, "+")
If pos > 0 Then .Cells(i, "I").Value = Left$(.Cells(i, "I").Value, pos - 1)
Next i
End With

With Worksheets("Assigned load").Columns("S:S")
.Replace "43410", "ABC"
.Replace "41235", "DEF"
.Replace "43404", "GHI"
.Replace "43405", "JKL"
.Replace "43407", "MNO"
.Replace "43408", "PQR"
End With

With Worksheets("Assigned load").Columns("Q:Q")
On Error Resume Next
Set r = r.SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo 0

If Not r Is Nothing Then
For Each c In r.Cells
If c.Value Like "PK#### *" Then c.Value = Right(c.Value, Len(c.Value) - 7)
Next
End If
End With

With Worksheets("Pivot")
.PivotTables("PivotTable1").PivotSelect "'Customer Name'[All]", xlLabelOnly, True
.PivotTables("PivotTable1").PivotCache.Refresh
.Range("D3").Select
End With

Application.ScreenUpdating = True


End Sub