Posts by vba_monkey

vba_monkey · Aug 23rd 2017

Re: VBA - Enter Formula only if Sheet Exists

I've managed to get it to work now, the PreviousReport workbook needs to be open.

I dont know why it would need to be open for this function when it can tell there's no sheet there when entering the vlookup and the workbook isnt open but that's Excel for you.

Thanks for the Help KjBox

vba_monkey · Aug 22nd 2017

Re: VBA - Enter Formula only if Sheet Exists

Thank you, I have tried your code and although it runs without error, it is now having the opposite affect to my code in that it is now adding the Vlookup to all tabs regardless of whether there is a corresposnding tab on the target workbook.

vba_monkey · Aug 21st 2017

Hello,

I am trying to write a macro that enters a Vlookup into a cell only if a corresponding tab exists on another workbbok to compare it to. I'm doing this to try to avoid the 'Select Sheet' Dialogue from appearing if there is no corresponding sheet on the other workbook.

This is what I have so far (the Function comes from here https://stackoverflow.com/ques…if-worksheetwsname-exists)

Code

Sub MySub()


Dim PreviousReport As String


If SheetExists(PreviousReport & ActiveSheet.Name) Then
    LastRow = .Cells(Rows.Count, 3).End(xlUp).Row
     ActiveSheet.Range("I7:I" & LastRow).Value = "=IFERROR(IF(VLOOKUP($B7,'[" & PreviousReport & "]" _
          & ActiveSheet.Name & "'!$B:$J,8,0)="""","""",VLOOKUP($B7,'[" & PreviousReport & "]" & ActiveSheet.Name & "'!$B:$I,8,0)),"""")"
Else
End If


End Sub


Function SheetExists(SheetToFind As String) As Boolean
Dim Sheet As Object
    SheetExists = False
    For Each Sheet In Worksheets
        If SheetToFind = Sheet.Name Then
            SheetExists = True
            Exit Function
        End If
    Next Sheet
End Function

Display More

The code works in that it doesnt enter a Vlookup if the sheet doesnt exists but it also doesnt recognise if the sheet does exist so I think the issue is with setting the SheetToFind.

Any ideas please?

Also posted here https://www.mrexcel.com/forum/…t-exists.html#post4893764
http://"https://stackoverflow.com/questions/6040164/excel-vba-if-worksheetwsname-exists"

http://"https://stackoverflow.com/questions/6040164/excel-vba-if-worksheetwsname-exists"

vba_monkey · Aug 11th 2017

Re: VBA - Escape Key and Error Handler

I can get it to work too on a blank sheet so there's obviously something going wrong in my workbook. Here's the full code, I'm not sure you'll be able to test as it involves updating pivot tables that are connect to a network data source.

I thought it might be this part that is doing it but commenting them out has no effect:

Code

Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

Full code:

Code

Private Sub OKButton_Click()


    On Error GoTo Error_Handler
    Dim Events As Boolean, Calc As Integer, ScrnUpd As Boolean, Alerts As Boolean
    Dim StartTime As Date, StopTime As Date, Elapsed As Date
    Dim FileName As String, Filepath As String
    Dim cond1() As String
    Dim cond3 As String
    Dim i As Long, j As Long, k As Long
    Dim Branch_Name As String, Branch As Variant
    Dim LastRow As Long
    Dim copy_start As Long, copy_end As Long
    Dim str1 As String, str2 As String
    Dim ws As Worksheet
    Dim Logo As Shape
    Dim f As String
    Dim Quarter As Integer
    
    Application.EnableCancelKey = xlErrorHandler
    
    Create_Reports_Form.Hide
    
    Events = Application.EnableEvents
    Calc = Application.Calculation
    ScrnUpd = Application.ScreenUpdating
    Alerts = Application.DisplayAlerts


'   Select File for previous report
    f = Application.GetOpenFilename(Title:="Select File")


'   Exit if cancel is selected
    If f = "False" Then Exit Sub


'   Set Filename
    FileName = Dir(f, vbDirectory)
    
    Call Show_Macro_Running_Form
    
    StartTime = Time
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Sheets("List").Visible = True
    Branch = Worksheets("List").Range("Branch")
    Set Logo = Sheets("List").Shapes("Picture 2")
    Quarter = (Month(Date) + 2) \ 3
    
'   Set UW months


    ReDim cond1(cmbMonthTo - cmbMonthFrom)
    
    For i = 0 To cmbMonthTo - cmbMonthFrom
        cond1(i) = "[DIM Policy UW Year Month].[Policy UW Month].&[" & Format(cmbMonthFrom + i, "00") & "]"
    Next i
    
    With Sheets("Policy")
        ActiveWorkbook.SlicerCaches("Slicer_Policy_UW_Month2").VisibleSlicerItemsList = Array(cond1)
    End With


    For i = 1 To 7 'When testing please change
    
        cond3 = "[DIM Branch].[BRANCH NAME].&[SJNKE " & Branch(i, 1) & "]"
        ActiveWorkbook.SlicerCaches("Slicer_BRANCH_NAME2").VisibleSlicerItemsList = Array(cond3)
        
        Call Variance2


        Worksheets.Add
        Range("A19").Select
        ActiveWindow.FreezePanes = True
        ActiveWindow.DisplayGridlines = False
        
        ActiveSheet.Name = Branch(i, 1)
        Branch_Name = Branch(i, 1)
 
        Worksheets("Policy").Range("TableHeaders").Copy Destination:=Sheets(Branch_Name).Cells(16, 1)
        Worksheets("Policy").Range("ColumnWidths").Copy
        Worksheets(Branch_Name).Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
        
        
        Sheets("Policy").Select
        copy_start = Cells.Find(What:="INSURED NAME").Row + 1
        
        For k = Cells.Find(What:="INSURED NAME").Row + 1 To Cells(Rows.Count, 1).End(xlUp).Row
            
            If Cells(k, 19).Value = "CHECK" Or Cells(k, 22).Value = "CHECK" Then
                copy_end = k
                Range(Cells(copy_start, 1), Cells(copy_end, 22)).Copy
                Sheets(Branch_Name).Select
                Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteAll
                Sheets("Policy").Select
            End If
            
            str1 = Cells(k, 1).Value
            str2 = Cells(k - 1, 1).Value
            
            If Len(str1) > Len(str2) And InStr(str1, str2) Then
                copy_start = k + 1
            End If
            
        Next k
        
'       Format
        Worksheets("List").Range("TableHeaders2").Copy Destination:=Sheets(Branch_Name).Cells(16, 1)
                
        With Sheets(Branch_Name)
                .Range(.Cells(19, 14), .Cells(19, 14).End(xlDown)).Copy
                .Range(.Cells(19, 1), .Cells(Rows.Count, 1).End(xlUp).Offset(0, 11)).PasteSpecial Paste:=xlPasteFormats
                .Cells(1, 2).Value = Branch_Name & " - Q" & Quarter & " " & Year(Date)
                .Cells(1, 2).Font.Bold = True
                .Cells(1, 2).Font.Size = 12
                .Cells(2, 2).Value = "Currency: UK - GBP, Non UK - EUR"
                .Cells(2, 2).Font.Bold = True
                .Cells(2, 2).Font.Size = 10
                .Rows("3:14").Delete
                .Columns(20).Insert
                .Columns(24).Insert
                .Columns(23).Copy
                .Columns(24).PasteSpecial Paste:=xlPasteFormats
                .Columns(20).Insert
                .Rows("2:3").Font.Size = 10
                .Cells(2, 20).Value = "1"
                .Cells(2, 20).HorizontalAlignment = xlCenter
                .Cells(2, 21).Value = "Incorrect. Amendment required."
                .Cells(3, 20).Value = "2"
                .Cells(3, 20).HorizontalAlignment = xlCenter
                .Cells(3, 21).Value = "Correct. No amendment required."
                .Cells(4, 20).Value = "Status"
                .Cells(4, 20).HorizontalAlignment = xlCenter
                .Cells(4, 21).Value = "Comments / Reasons"
        End With
        
 '       Check(1)
        With Sheets(Branch_Name)
            For j = 7 To .Cells(Rows.Count, 1).End(xlUp).Row
                If .Cells(j, 19).Value = "CHECK" Then
                    With .Cells(j, 20).Validation
                        .Delete
                        .Add Type:=xlValidateList, _
                            Operator:=xlEqual, _
                            Formula1:="1,2"
                    End With
                    With .Cells(j, 20)
                        .HorizontalAlignment = xlCenter
                        .Font.Bold = True
                    End With
                End If
            Next j
        End With
        
'       Check(2)
        With Sheets(Branch_Name)
            .Columns(25).Insert
            .Cells(2, 25).Value = "1"
            .Cells(2, 25).HorizontalAlignment = xlCenter
            .Cells(2, 26).Value = "Incorrect. Amendment required."
            .Cells(3, 25).Value = "2"
            .Cells(3, 25).HorizontalAlignment = xlCenter
            .Cells(3, 26).Value = "Correct. No amendment required."
            .Cells(4, 25).Value = "Status"
            .Cells(4, 25).HorizontalAlignment = xlCenter
            .Cells(4, 26).Value = "Comments / Reasons"
        End With
        
        With Sheets(Branch_Name)
            For j = 7 To .Cells(Rows.Count, 1).End(xlUp).Row
                If .Cells(j, 24).Value = "CHECK" Then
                    With .Cells(j, 25).Validation
                        .Delete
                        .Add Type:=xlValidateList, _
                            Operator:=xlEqual, _
                            Formula1:="1,2"
                    End With
                    With .Cells(j, 25)
                        .HorizontalAlignment = xlCenter
                        .Font.Bold = True
                    End With
                End If
            Next j
       End With
       
        With Sheets(Branch_Name)
            .Columns(20).ColumnWidth = 6.75
            .Columns(25).ColumnWidth = 6.75
            .Columns(21).ColumnWidth = 32.5
            .Columns(26).ColumnWidth = 32.5
        End With
        
'       Insert Vlookups to draw through comments
        With Sheets(Branch_Name)
                    LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
                    .Range("A:B").EntireColumn.Insert
                    .Range("A7:A" & LastRow).Value = "=$C7&$D7&ROUND($S7,5)"
                    .Range("B7:B" & LastRow).Value = "=$D7&$E7&ROUND($X7,5)"
                    .Range("V7:V" & LastRow).Value = "=IFERROR(IF(VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,22,0)="""","""",VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,22,0)),"""")"
                    .Columns("V").EntireColumn.HorizontalAlignment = xlCenter
                    .Range("W7:W" & LastRow).Value = "=IFERROR(IF(VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,23,0)="""","""",VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,23,0)),"""")"
                    .Range("AA7:AA" & LastRow).Value = "=IFERROR(IF(VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,27,0)="""","""",VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,27,0)),"""")"
                    .Columns("AA").EntireColumn.HorizontalAlignment = xlCenter
                    .Range("AB7:AB" & LastRow).Value = "=IFERROR(IF(VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,28,0)="""","""",VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,28,0)),"""")"
                    .Columns("A:AB").Copy
                    .Columns("A:AB").PasteSpecial Paste:=xlPasteValues
                    Application.CutCopyMode = False
                    .Columns("A:B").EntireColumn.Hidden = True
                    Logo.Copy
                    .Paste Destination:=Sheets(Branch_Name).Range("C1")
                    .Tab.ThemeColor = xlThemeColorAccent2
        End With
    
    Next i
    
    Worksheets("ALL Branches").Delete
    Worksheets("Summary").Delete
    Worksheets("Policy").Delete
    Worksheets("Version History").Delete
    Worksheets("List").Delete
    
    Sheets(1).Activate
    
    For Each ws In ThisWorkbook.Worksheets
        With ws
            .Activate
            .Range("C6").Select
        End With
    Next ws


    Unload Create_Reports_Form
    Unload Macro_Running_Form
    
    StopTime = Time
    
    Filepath = "R:\SJE Shared\DMU\Data Checking\" & Year(Date) & "\Q" & Quarter & "\Gross Premium\"
    ActiveWorkbook.SaveAs FileName:=Filepath & Replace(ActiveWorkbook.Name, "ver_3.0_LIVE.xlsm", Format(Date, "mm") & "_" & Format(Date, "dd") & ".xlsx"), FileFormat:=51, AccessMode:=xlShared
    
    Application.EnableEvents = Events
    Application.Calculation = Calc
    Application.ScreenUpdating = ScrnUpd
    Application.DisplayAlerts = Alerts
    
    Elapsed = StopTime - StartTime
    MsgBox "Refresh completed !!" & vbCrLf & vbCrLf & "Time elapsed: " & Minute(Elapsed) & " minutes " & Second(Elapsed) & " seconds", vbInformation
Exit Sub


'   Reset if exiting due to error
Error_Handler:
If Err = 18 Then
    Application.EnableEvents = Events
    Application.Calculation = Calc
    Application.ScreenUpdating = ScrnUpd
    Application.DisplayAlerts = Alerts
    Unload Create_Reports_Form
    Unload Macro_Running_Form
    Sheets("List").Visible = False
    MsgBox "Macro exited...", vbExclamation, "Stopped!"
Else
    Application.EnableEvents = Events
    Application.Calculation = Calc
    Application.ScreenUpdating = ScrnUpd
    Application.DisplayAlerts = Alerts
    Unload Create_Reports_Form
    Unload Macro_Running_Form
    Sheets("List").Visible = False
    Debug.Print "Line: " & Erl & " Error No. " & Err & "  Desc: " & Err.Description
    MsgBox "An error occurred, exiting macro...", vbCritical, "Error!"
End If


End Sub

Display More

vba_monkey · Aug 11th 2017

Re: VBA - Escape Key and Error Handler

Thanks, I've already seen that but it doesnt really answer why my code isnt working as it says it should in that article. I have a Go To statement and EnableCancelKey is set to xlErrorHandler. If Esc is pressed then it goes tp the error handler as it should but then seems to return to xlInterrupt without running through the code in the error handler.

vba_monkey · Aug 9th 2017

Hello,

I am trying to get excel to go to my error handler if Esc is pressed whilst the macro is running. This is what I have so far but when I press Esc, Excel goes to the error handler and breaks on the first line with error 'User interrupt occurred' instead of running through the code in the error handler:

Code

On Error GoTo Error_Handler


Application.EnableCancelKey = xlErrorHandler


Error_Handler:
If Err = 18 Then
    MsgBox "Macro exited...", vbExclamation, "Stopped!"
Else
    Debug.Print "Line: " & Erl & "  Desc: " & Err.Description
    MsgBox "An error occurred, exiting macro...", vbCritical, "Error!"
End If

Display More

Any ideas please?

Also posted here:
https://www.mrexcel.com/forum/…pe-key-error-handler.html

vba_monkey · Aug 9th 2017

Re: VBA - Problem with Selecting Save As Directory

Thank you, that's what I needed.

vba_monkey · Aug 8th 2017

Hello,

This code comes at the end of a macro and is supposed to save the workbook in the correct folder. The folders are labelled Jan, Feb Mar etc. and the file should be saved in the previous months folder so, current month - 1. The codes works but it always saves the workbook in the Jan folder.

Can anyone see what's wrong?

Code

Dim Filepath As String


Filepath = "V:\DMU\Split Report Reconciliations\OS Claims\" & Year(Date) & "\" & Format(Month(Date) - 1, "mmm") & "\"
ActiveWorkbook.SaveAs Filename:=Filepath & Replace(ActiveWorkbook.Name, ".xlsm", "_" & Format(Date, "yyyy") & "_" & Format(Date, "mm") & "_" & Format(Date, "dd") & ".xlsx"), FileFormat:=51

Thanks

vba_monkey · Aug 8th 2017

Re: VBA - Using Relative References

Cheers Bruce, that works great.

vba_monkey · Aug 7th 2017

Re: VBA - Using Relative References

Thanks, that does work but I dont want to put a formula into the cell, just the value.

vba_monkey · Aug 7th 2017

Hello,

The point of this code is to insert column B, copy the header from the first cell on the left into B1 and then insert "SJ-" followed by the value in the cell to the left (A2) in B2 down to the bottom of the data.

Code

Sub test()
Dim LastRow As Long


LastRow = Cells(Rows.Count, 1).End(xlUp).Row


Range("B1").EntireColumn.Insert
Range("B1").FillRight
Range("B2:B" & LastRow).FormulaR1C1 = "SJ-" & Cells(2, 1)


End Sub

Display More

The problem is that every cell contains "SJ-" and the value of A2 so the question is, how to make Cells(2, 1) relative so that it always using the value to the left of the cell?

vba_monkey · Aug 3rd 2017

Re: Need help with Vlookup not working

Thanks for that, you just spotted the obvious thing I missed, No SJ- prefix in column A.

Sometime you just cant see for looking :?

vba_monkey · Aug 3rd 2017

Hello,

Can someone please take a look at the attached file to see if you can figure out why the Vlookup in column C is not working? I've tried everything that I can think of like; they are both formatted the same, I've tried copying the data to a different spreadsheet, I've copied it to a text file and back again and I've tried TRIM and CLEAN to see if there was anything invisible that was stopping it from working but no success.

I've confirmed that the values are presnt in both columns for instance the value in A2 can be found in B1092 using Ctrl-F so, if Excel can find it that why, why cant the Vlookup find it?

Any ideas please?

Thanks

Also posted here:

https://www.mrexcel.com/forum/…-working.html#post4882356

vba_monkey · Jul 26th 2017

Re: VBA - Clearing Selection of Picture

Bump

vba_monkey · Jul 25th 2017

Re: VBA - Clearing Selection of Picture

Not sure why but putting .Activate in causes my vlookupos to either not be entered or deleted. I've tried step through the code and it seems to work but when running on it's own, it does not.

If it helps, here is the whole of the code i'm running

Code

Private Sub OKButton_Click()
    Dim StartTime, StopTime, Elapsed As Variant
    Dim FileName As String
    Dim Filepath As String
    Dim cond3 As String
    Dim Branch As Variant
    Dim i As Long
    Dim k As Long
    Dim Branch_Name As String
    Dim LastRow As Long
    Dim copy_start As Long
    Dim copy_end As Long
    Dim str1 As String
    Dim str2 As String
    Dim j As Long
    Dim ws As Worksheet
    Dim Logo As Shape
    Dim f As String
    
    Set Logo = Sheets("List").Shapes("Picture 2")
    
    UserForm1.Hide
    StartTime = Time
'   Select File for previous report
    f = Application.GetOpenFilename(Title:="Select File")
'   Exit if cancel is selected
    If f = "False" Then Exit Sub
'   Set Filename
    FileName = Dir(f, vbDirectory)
    
    Call Show_UserForm2
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    Sheets("List").Visible = True
    Branch = Worksheets("List").Range("Branch")
    
'   Set UW months
    
    If cmbQuarter = "Q1" Then
            ActiveWorkbook.SlicerCaches("Slicer_Policy_UW_Month2").VisibleSlicerItemsList = Array("[DIM Policy UW Year Month].[Policy UW Month].&[01]", "[DIM Policy UW Year Month].[Policy UW Month].&[02]", "[DIM Policy UW Year Month].[Policy UW Month].&[03]")
        ElseIf cmbQuarter = "Q2" Then
            ActiveWorkbook.SlicerCaches("Slicer_Policy_UW_Month2").VisibleSlicerItemsList = Array("[DIM Policy UW Year Month].[Policy UW Month].&[04]", "[DIM Policy UW Year Month].[Policy UW Month].&[05]", "[DIM Policy UW Year Month].[Policy UW Month].&[06]")
        ElseIf cmbQuarter = "Q3" Then
            ActiveWorkbook.SlicerCaches("Slicer_Policy_UW_Month2").VisibleSlicerItemsList = Array("[DIM Policy UW Year Month].[Policy UW Month].&[07]", "[DIM Policy UW Year Month].[Policy UW Month].&[08]", "[DIM Policy UW Year Month].[Policy UW Month].&[09]")
        ElseIf cmbQuarter = "Q4" Then
            ActiveWorkbook.SlicerCaches("Slicer_Policy_UW_Month2").VisibleSlicerItemsList = Array("[DIM Policy UW Year Month].[Policy UW Month].&[10]", "[DIM Policy UW Year Month].[Policy UW Month].&[11]", "[DIM Policy UW Year Month].[Policy UW Month].&[12]")
        Else
    End If
    For i = 1 To 7 'When testing please change
    
        cond3 = "[DIM Branch].[BRANCH NAME].&[SJNKE " & Branch(i, 1) & "]"
        ActiveWorkbook.SlicerCaches("Slicer_BRANCH_NAME2").VisibleSlicerItemsList = Array(cond3)
        
        Application.Calculation = xlCalculationManual
        
        Call Variance2
        Worksheets.Add
        Range("A19").Select
        ActiveWindow.FreezePanes = True
        ActiveWindow.DisplayGridlines = False
        
        ActiveSheet.Name = Branch(i, 1)
        Branch_Name = Branch(i, 1)
 
        Worksheets("Policy").Range("TableHeaders").Copy Destination:=Sheets(Branch_Name).Cells(16, 1)
        Worksheets("Policy").Range("ColumnWidths").Copy
        Worksheets(Branch_Name).Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
        
        
        Sheets("Policy").Select
        copy_start = Cells.Find(What:="INSURED NAME").Row + 1
        
        For k = Cells.Find(What:="INSURED NAME").Row + 1 To Cells(Rows.Count, 1).End(xlUp).Row
            
            If Cells(k, 19).Value = "CHECK" Or Cells(k, 22).Value = "CHECK" Then
                copy_end = k
                Range(Cells(copy_start, 1), Cells(copy_end, 22)).Copy
                Sheets(Branch_Name).Select
                Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteAll
                Sheets("Policy").Select
            End If
            
            str1 = Cells(k, 1).Value
            str2 = Cells(k - 1, 1).Value
            
            If Len(str1) > Len(str2) And InStr(str1, str2) Then
                copy_start = k + 1
            End If
            
        Next k
        
'       Format
        Worksheets("List").Range("TableHeaders2").Copy Destination:=Sheets(Branch_Name).Cells(16, 1)
                
        With Sheets(Branch_Name)
                .Range(.Cells(19, 14), .Cells(19, 14).End(xlDown)).Copy
                .Range(.Cells(19, 1), .Cells(Rows.Count, 1).End(xlUp).Offset(0, 11)).PasteSpecial Paste:=xlPasteFormats
                .Cells(1, 2).Value = Branch_Name & " - " & cmbQuarter & " " & Year(Date)
                .Cells(1, 2).Font.Bold = True
                .Cells(1, 2).Font.Size = 12
                .Cells(2, 2).Value = "Currency: UK - GBP, Non UK - EUR"
                .Cells(2, 2).Font.Bold = True
                .Cells(2, 2).Font.Size = 10
                .Rows("3:14").Delete
                .Columns(20).Insert
                .Columns(24).Insert
                .Columns(23).Copy
                .Columns(24).PasteSpecial Paste:=xlPasteFormats
                .Columns(20).Insert
                .Rows("2:3").Font.Size = 10
                .Cells(2, 20).Value = "1"
                .Cells(2, 20).HorizontalAlignment = xlCenter
                .Cells(2, 21).Value = "Incorrect. Amendment required."
                .Cells(3, 20).Value = "2"
                .Cells(3, 20).HorizontalAlignment = xlCenter
                .Cells(3, 21).Value = "Correct. No amendment required."
                .Cells(4, 20).Value = "Status"
                .Cells(4, 20).HorizontalAlignment = xlCenter
                .Cells(4, 21).Value = "Comments / Reasons"
                Logo.Copy
                .Paste Destination:=Sheets(Branch_Name).Range("C1")
        End With
        
 '       Check(1)
        With Sheets(Branch_Name)
            For j = 7 To .Cells(Rows.Count, 1).End(xlUp).Row
                If .Cells(j, 19).Value = "CHECK" Then
                    With .Cells(j, 20).Validation
                        .Delete
                        .Add Type:=xlValidateList, _
                            Operator:=xlEqual, _
                            Formula1:="1,2"
                    End With
                    With .Cells(j, 20)
                        .HorizontalAlignment = xlCenter
                        .Font.Bold = True
                    End With
                End If
            Next j
        End With
        
'       Check(2)
        With Sheets(Branch_Name)
            .Columns(25).Insert
            .Cells(2, 25).Value = "1"
            .Cells(2, 25).HorizontalAlignment = xlCenter
            .Cells(2, 26).Value = "Incorrect. Amendment required."
            .Cells(3, 25).Value = "2"
            .Cells(3, 25).HorizontalAlignment = xlCenter
            .Cells(3, 26).Value = "Correct. No amendment required."
            .Cells(4, 25).Value = "Status"
            .Cells(4, 25).HorizontalAlignment = xlCenter
            .Cells(4, 26).Value = "Comments / Reasons"
        End With
        
        With Sheets(Branch_Name)
            For j = 7 To .Cells(Rows.Count, 1).End(xlUp).Row
                If .Cells(j, 24).Value = "CHECK" Then
                    With .Cells(j, 25).Validation
                        .Delete
                        .Add Type:=xlValidateList, _
                            Operator:=xlEqual, _
                            Formula1:="1,2"
                    End With
                    With .Cells(j, 25)
                        .HorizontalAlignment = xlCenter
                        .Font.Bold = True
                    End With
                End If
            Next j
       End With
       
        With Sheets(Branch_Name)
            .Columns(20).ColumnWidth = 6.75
            .Columns(25).ColumnWidth = 6.75
            .Columns(21).ColumnWidth = 32.5
            .Columns(26).ColumnWidth = 32.5
        End With
        
'       Insert Vlookups to draw through comments
        With Sheets(Branch_Name)
                    LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
                    .Range("A:B").EntireColumn.Insert
                    .Range("A7:A" & LastRow).Value = "=$C7&$D7&ROUND($S7,5)"
                    .Range("B7:B" & LastRow).Value = "=$D7&$E7&ROUND($X7,5)"
                    .Range("V7:V" & LastRow).Value = "=IFERROR(IF(VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,22,0)="""","""",VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,22,0)),"""")"
                    .Columns("V").EntireColumn.HorizontalAlignment = xlCenter
                    .Range("W7:W" & LastRow).Value = "=IFERROR(IF(VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,23,0)="""","""",VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,23,0)),"""")"
                    .Range("AA7:AA" & LastRow).Value = "=IFERROR(IF(VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,27,0)="""","""",VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,27,0)),"""")"
                    .Columns("AA").EntireColumn.HorizontalAlignment = xlCenter
                    .Range("AB7:AB" & LastRow).Value = "=IFERROR(IF(VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,28,0)="""","""",VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,28,0)),"""")"
                    .Columns("A:AB").Copy
                    .Columns("A:AB").PasteSpecial Paste:=xlPasteValues
                    .Columns("A:B").EntireColumn.Hidden = True
                    .Range("C6").Select
                    .Tab.ThemeColor = xlThemeColorAccent2
        End With
    
    Next i
    
    Worksheets("ALL Branches").Delete
    Worksheets("Summary").Delete
    Worksheets("Policy").Delete
    Worksheets("Version History").Delete
    Worksheets("List").Delete
    
    StopTime = Time
    Unload UserForm1
    Unload UserForm2
    
    Filepath = "R:\SJE Shared\DMU\Data Checking\" & Year(Date) & "\" & cmbQuarter & "\Gross Premium\"
    ActiveWorkbook.SaveAs FileName:=Filepath & Replace(ActiveWorkbook.Name, "ver_3.0_LIVE.xlsm", Format(Date, "mm") & "_" & Format(Date, "dd") & ".xlsx"), FileFormat:=51, AccessMode:=xlShared
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    Elapsed = StopTime - StartTime
    MsgBox "Refresh completed !!" & vbCrLf & vbCrLf & "Time elapsed: " & Minute(Elapsed) & " minutes " & Second(Elapsed) & " seconds", vbInformation
End Sub

Display More

I've tried putting this line of code somewhere else in the macro and the result is always the same.

vba_monkey · Jul 25th 2017

Hello,

I have this code which does various things on a worksheet but the issue I'm having is with the last three lines:

Code

With Sheets(Branch_Name)
                    LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
                    .Range("A:B").EntireColumn.Insert
                    .Range("A7:A" & LastRow).Value = "=$C7&$D7&ROUND($S7,5)"
                    .Range("B7:B" & LastRow).Value = "=$D7&$E7&ROUND($X7,5)"
                    .Range("V7:V" & LastRow).Value = "=IFERROR(IF(VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,22,0)="""","""",VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,22,0)),"""")"
                    .Columns("V").EntireColumn.HorizontalAlignment = xlCenter
                    .Range("W7:W" & LastRow).Value = "=IFERROR(IF(VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,23,0)="""","""",VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,23,0)),"""")"
                    .Range("AA7:AA" & LastRow).Value = "=IFERROR(IF(VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,27,0)="""","""",VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,27,0)),"""")"
                    .Columns("AA").EntireColumn.HorizontalAlignment = xlCenter
                    .Range("AB7:AB" & LastRow).Value = "=IFERROR(IF(VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,28,0)="""","""",VLOOKUP($A7,'[" & FileName & "]" & .Name & "'!$A:$AB,28,0)),"""")"
                    .Columns("A:AB").Copy
                    .Columns("A:AB").PasteSpecial Paste:=xlPasteValues
                    .Columns("A:B").EntireColumn.Hidden = True
                    Logo.Copy
                    .Paste Destination:=Sheets(Branch_Name).Range("C1")
                    .Cells("C6").Select
        End With

Display More

The issue is that once the macro has finished, the logo image that was copied over remains selected which looks untidy so I wanted to unselect it by moving to a different cell which is the purpose of the last line. The problem is that no matter what I try (.Range("C6").Select, Cells("C6").Select, Cells(6, 3).Select etc.) all return the same error 'Select method of Range class failed'

Application.CutCopyMode = False also has no effect.

What am I doing wrong?

Thanks

This has also been posted here:

https://www.mrexcel.com/forum/…ng-selection-picture.html

vba_monkey · Jun 28th 2017

Re: VBA - Setting PivotField value in OLAP Pivot Table

Thanks Rory, but that produces the same error.

vba_monkey · Jun 28th 2017

Hello,

Can anyone please tell me why the below codes returns the error 'The item could not be found in the OLAP Cude'. The macro stops on the third line of the Else statement when trying to set field filter values, the two lines before it which clear the filters work ok.

'Year' and 'Month' are both variables selected by the user on a UserForm and I think the issue is getting the variable into the Array().

Code

Dim Month As String
Dim Year As String


Month = "[Dim Dpm Policy Main].[UW YEAR].&[" & UserForm1.Month & "]"
Year = "[Dim Dpm Policy Main].[UW MONTH].&[" & UserForm1.Year & "]"


'   Filter Pivots
    For Each ws In ThisWorkbook.Worksheets
        With ws
            If .Name = "Read me_E" Then
                Else
                    .Select
                    .PivotTables("PivotTable1").PivotFields("[Dim Dpm Policy Main].[UW YEAR].[UW YEAR]").ClearAllFilters
                    .PivotTables("PivotTable1").PivotFields("[Dim Dpm Policy Main].[UW MONTH].[UW MONTH]").ClearAllFilters
                    .PivotTables("PivotTable1").PivotFields("[Dim Dpm Policy Main].[UW YEAR].[UW YEAR]").VisibleItemsList = Array(Year)
                    .PivotTables("PivotTable1").PivotFields("[Dim Dpm Policy Main].[UW MONTH].[UW MONTH]").VisibleItemsList = Array(Month)
                    .PivotTables("PivotTable1").RefreshTable
            End If
        End With
    Next ws

Display More

It may also be that the variables have been declared as String, I've done it this way as the user has the option of 'All' to select.

Thanks

vba_monkey · Jun 23rd 2017

Re: Insert Vlookup into Cell with Variable Array

Thanks both. This is what works:

Code

Range("B10").Value = "=VLOOKUP(A10,'[" & Filename & "]sheet1'!A:B,2,0)"

vba_monkey · Jun 22nd 2017

Re: Insert Vlookup into Cell with Variable Array

Thanks but it's not how to retreive the filename that I need but how to get it into the vlookup in the cell.