optimizing vba code or suggestion of solution

[tonypiha]

Hi all,
I play poker and I use an excel with specific ranges of cards. The cards you will call a bet depends on the position of the raiser and the position you are calling. I have matrix with the cards with named ranges
The position´s name are:
EP
MP
CO
BTN
SB
BB

So if the EP open raise with a bet and I am sitting at MP, I have a range called Call_MP_vs_EP
So I did 2 columns of buttons that assign the respective string to a cell ( here, P40 and Q40)and the I have a button that run a macro to call the specific range
The Macro is below. I am wondering if there is a smarter way to do it
And it is not possible to have the same positions, for instance EP vs EP


Private Sub MP_Click()


' range call of MP vs EP
Dim Raise As Variant
Dim vscall As Variant
Dim atencao As String


'vscall = define caller position


'Raise = define raiser position


vscall = Sheets("Dashboard").Range("p40").Value
Raise = Sheets("Dashboard").Range("q40").Value

Application.ScreenUpdating = False


'delete previous range
Sheets("Dashboard").Range("B3:N20").Delete

'Not possible to have 2 positions at same time, then go to error msg


On Error GoTo atencao
'Select, copy and past the defined range based on Q40 and P40 cell value


Application.Range("Call_" & vscall & "_vs_" & Raise).Copy
Sheets("Dashboard").Select
Sheets("Dashboard").Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False

On Error GoTo atencao
Range("A1").Select
Application.ScreenUpdating = True

atencao: MsgBox "ranges inválidos"


End Sub

 

[JackDanIce]

Welcome to the board.

Is this what you mean? Try:

Private Sub MP_Click()
    
    Dim strRange    As String
    
    strRange = "Call_@P40_vs_@Q40"
    
    With Sheets("Dashboard")
        .Select
        
        If .Cells(40, 16).Value = .Cells(40, 17).Value Then
            MsgBox "ranges inválidos", vbExclamation, "Ranges Inválidos"
            Exit Sub
        End If
        
        Application.ScreenUpdating = False
        
        .Cells(3, 2).Resize(18, 13).ClearContents
        
        strRange = Replace(strRange, "@P40", .Cells(40, 16).Value)
        strRange = Replace(strRange, "@Q40", .Cells(40, 17).Value)
        
        On Error Resume Next
        Range(strRange).Copy
        .Cells(4, 2).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        Application.CutCopyMode = False
        On Error GoTo 0
                    
    End With
    
    With Application
        .Goto Cells(1, 1), True
        .ScreenUpdating = True
    End With
    
End Sub

 

[tonypiha]

Thanks , I really appreciate

But, it worked only once and just the formatting was pasted, the values of the cells don´t

 

[JackDanIce]

This should post the values:

Private Sub MP_Click()
    
    Dim strRange    As String
    
    strRange = "Call_@P40_vs_@Q40"
    
    With Sheets("Dashboard")
        .Select
        
        If .Cells(40, 16).Value = .Cells(40, 17).Value Then
            MsgBox "ranges inválidos", vbExclamation, "Ranges Inválidos"
            Exit Sub
        End If
        
        Application.ScreenUpdating = False
        
        .Cells(3, 2).Resize(18, 13).ClearContents
        
        strRange = Replace(strRange, "@P40", .Cells(40, 16).Value)
        strRange = Replace(strRange, "@Q40", .Cells(40, 17).Value)
        
        On Error Resume Next
        Range(strRange).Copy
        .Cells(4, 2).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        .Cells(4, 2).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        On Error GoTo 0
                    
    End With
    
    With Application
        .Goto Cells(1, 1), True
        .ScreenUpdating = True
    End With
    
End Sub

When you say only ran once, did you change the values in P40 and Q40?

Can you list all the possible combinations there are of P40 and Q40?

Do you have named ranges for all of these combinations, which the code should copy and paste into B4?

 

[tonypiha]

Thank you very much
the range name is correctly defined( I checked passing the mouse over strRange variable), but nothing is being pasted in target cell
When I disabled the line, on error resume next it returned an error

 

[JackDanIce]

What did the error say? I'm guessing the names are not matching.

Can you post the exact range names please to see if the code is generating the same names of range to copy - since this is what is not being pasted.

 

[tonypiha]

one range is named:

Call_MP_vs_CO

the error:
error on the application definition or object definition

 

[tonypiha]

I added the line Range(strRange).select to test and the right range is selected, so I assume the names are correct...

 

[JackDanIce]

Try:

Private Sub MP_Click()
    
    Dim strRange    As String
    
    strRange = "Call_@P40_vs_@Q40"
    
    With Sheets("Dashboard")
        .Select
        
        If .Cells(40, 16).Value = .Cells(40, 17).Value Then
            MsgBox "ranges inválidos", vbExclamation, "Ranges Inválidos"
            Exit Sub
        End If
        
        Application.ScreenUpdating = False
        
        .Cells(3, 2).Resize(18, 13).ClearContents
        
        strRange = Replace(strRange, "@P40", .Cells(40, 16).Value)
        strRange = Replace(strRange, "@Q40", .Cells(40, 17).Value)
                
        .Range(strRange).Copy
        .Cells(4, 2).PasteSpecial Paste:=xlPasteFormats
        .Cells(4, 2).PasteSpecial Paste:=xlPasteValues
                    
    End With
    
    With Application
        .CutCopyMode = False
        .Goto Cells(1, 1), True
        .ScreenUpdating = True
    End With
    
End Sub

 

[tonypiha]

it is in another worksheet at the same workbook
the above code(test) return the same error