Problem in Executing the Code

[Sarfaraz]

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]

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]

just guess but should:

[vba]Left$(.Cells(i, "I").Value, pos - 1)[/vba]

really be
[vba]Left(.Cells(i, "I").Value, pos - 1)[/vba]

[Paul_Hossler]

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]

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